为什么我的收藏空白？

Question

这是一个VBA脚本。我不确定为什么我的收藏没有填充“按市场”表格。

Sub ArrayPractice() 

Dim r As Integer 
Dim i As Integer 
Dim a As Integer 
Dim numberOfRows As Integer 
Dim names() As String 
Dim resourceCollect As Collection 

Dim Emp As Resource 
Dim Count As Long 

Set resourceCollect = New Collection 

a = Worksheets("DATA").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 
r = 2 'row that i start looping from 
i = 0 

For Each Emp In resourceCollect 

For Count = 0 To a 
Emp.Name = Cells(r, 1).Value 
Emp.Title = Cells(r, 2).Value 
Emp.City = Cells(r, 3).Value 
resourceCollect.Add Emp 
r = r + 1 
Next Count 
Next Emp 

''''print the array!'''' 

Sheets.Add.Name = "By Market" 
Sheets.Add.Name = "By Resource Level" 
Sheets.Add.Name = "By Resource Manager" 



Sheets("By Market").Select 
Range("C36").Select 
r = 36 
For Each Emp In resourceCollect 
If Emp.City = "Dallas" Then 
Cells(r, 3).Select 
Debug.Print Emp.Name 
r = r - 1 
End If 
Next Emp 

Range("D36:D36").Select 
r = 36 
For Each Emp In resourceCollect 
If Emp.City = "Denver" Then 
Cells(r, 4).Select 
Debug.Print Emp.Name 
r = r - 1 
End If 
Next Emp 

Range("E36:E36").Select 
r = 36 
For Each Emp In resourceCollect 
If Emp.City = "Houston" Then 
Cells(r, 5).Select 
Debug.Print Emp.Name 
r = r - 1 
End If 
Next Emp 

Range("F36:F36").Select 
r = 36 
For Each Emp In resourceCollect 
If Emp.City = "Kansas City (Missouri)" Then 
Cells(r, 6).Select 
Debug.Print Emp.Name 
r = r - 1 
End If 
Next Emp 

End Sub 

UPDATE

每约瑟夫的答案，这里就是我试过。我还没有工作。

这里有几个不同的我一直在搞的Subs。他们都试图完成同样的问题。

Sub stackResources() 

Dim c As New Collection 

Dim r1 As Excel.Range 'an object 
Dim r2 As Excel.Range 
Dim r3 As Excel.Range 


Set r1 = Range("A1") 
Set r2 = Range("B1") 
Set r3 = Range("C1") 

c.Add r1 
c.Add r2 
c.Add r3 

Sheets("By Market").Select 
Range("A1").Select 

Dim i As Long 
For i = 1 To c.Count 
    Debug.Print c.Item(i) 
    Next 


End Sub 

Sub collectionTest() 
Dim c As New Collection 

Dim emp As Resource 


Sheets("DATA").Select 

Range("A1").Select 

Do Until Selection.Value = "" 
    emp.name = Selection.Value 
     ActiveCell.Offset(0, 1).Select 
    emp.Title = Selection.Value 
     ActiveCell.Offset(0, 1).Select 
    emp.city = Selection.Value 
     c.Add emp 

    Loop 


Sheets("By Market").Select 
Range("A1").Select 

Dim i As Long 
For i = 1 To c.Count 
    Debug.Print c.Item(i) 
    Next 




End Sub 

Sub printACollection() 

Dim c As New Collection 

Dim s1 As String 
Dim s2 As String 
Dim s3 As String 

Sheets("DATA").Select 

Dim r As Long 


r = 1 
For Each cell In Range("A1") 
    s1 = cell.Value 
    c.Add s1 
    ActiveCell.Offset(0, 1).Select 
    s2 = cell.Value 
    c.Add s2 
    ActiveCell.Offset(0, 1).Select 
    s3 = cell.Value 
    c.Add s3 
    Next 


    Sheets("By Market").Select 

     Dim i As Long 

    For i = 1 To c.Count 
     Debug.Print c.Item(i) 
    Next 



End Sub 

Answer 1

这是根据您的意见的另一个答案。我认为这是你要找的。如果没有，请更具描述性并修改您的问题。

你叫员工用代码的类模块：

Option Explicit 

Public Name As String 
Public City As String 
Public Title As String 

然后，在常规的模块，你可以像下面。密切关注该示例并根据需要对其进行修改。我离开了Sort代码，所以你可以自己试一试。另外，请注意我如何将工作分解为单独的函数/子目录。这使您的代码保持清洁，并且更易于遵循。希望这可以帮助。

Option Explicit 

Public Sub main() 
    Application.ScreenUpdating = False 

    Dim c As Collection 
    Dim newWs As Excel.Worksheet 
    Dim rData As Excel.Range 

    Set rData = ThisWorkbook.Sheets("Sheet1").Range("A2:C3") 

    Set c = getData(rData) 
    Set newWs = ThisWorkbook.Worksheets.Add 

    newWs.Name = "New report" 

    Call putCollectionInWorksheet(newWs, c) 

    Call sortData(newWs) 

    Application.ScreenUpdating = True 
End Sub 

Private Function getData(ByRef rng As Excel.Range) As Collection 
    ' create new collection of data 
    Dim c As New Collection 
    Dim i As Long 
    Dim e As Employee 
    For i = 1 To rng.Rows.Count 
     Set e = New Employee 

     e.Name = rng.Cells(i, 1) ' name column 
     e.Title = rng.Cells(i, 2) ' title column 
     e.City = rng.Cells(i, 3) ' city column 

     c.Add e 
    Next i 

    Set getData = c 
End Function 

Private Sub putCollectionInWorksheet(ByRef ws As Excel.Worksheet, ByRef cData As Collection) 
    Dim i As Long, j As Long 
    Dim emp As Employee 

    ' create header info 
    ws.Range("A1:C1") = Array("Name", "Title", "City") 
    i = 2 ' current row 

    For Each emp In cData 
     ws.Cells(i, 1).Value = emp.Name 
     ws.Cells(i, 2).Value = emp.Title 
     ws.Cells(i, 3).Value = emp.City 

     i = i + 1 
    Next emp 
End Sub 

Private Sub sortData(ByRef ws As Excel.Worksheet) 
    ' code here 
End Sub 

Answer 2

发生了什么事是resourceCollect什么都没有，所以实际上你没有循环任何东西。您必须将项目添加到集合才能循环访问。

这是一个基本的教程，可以帮助：

http://www.wiseowl.co.uk/blog/s239/collections.htm

编辑：为了回答您的评论：

Public Sub test() 
    Dim c As New Collection 

    Dim s1 As String 
    Dim s2 As String 
    Dim s3 As String 

    s1 = "hello" 
    s2 = "," 
    s3 = "world" 

    c.Add s1 
    c.Add s2 
    c.Add s3 

    Dim s As String 

    For Each s In c 
     Debug.Print s 
    Next 
End Sub 

这将失败，因为你可以通过使用String数据类型不循环播放...因为这只是一种数据类型而不是对象。在这种情况下，您可以通过索引（？索引）必须循环：

Dim i As Long 

    For i = 1 To c.Count 
     Debug.Print c.Item(i) 
    Next 

但是，如果您使用的是众所周知的VBA公司，比如对象，范围：

Public Sub test2() 
    Dim c As New Collection 

    Dim r1 As Excel.Range ' an object 
    Dim r2 As Excel.Range 

    Set r1 = Range("A1") 
    Set r2 = Range("A3") 

    c.Add r1 
    c.Add r2 

    Dim r As Excel.Range 
    For Each r In c 
     Debug.Print r.Address 
    Next r 
End Sub 

这将工作很好。

如果您正在使用自定义类，则可以像使用Range对象一样使用对象循环访问集合。我参考的链接解释了可能存在的问题以及创建自己的Collection对象的解决方案。