为什么我的collections空白？

这是一个VBA脚本。 我不知道为什么我的collections没有填充“按市场”工作表。

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

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

您有一个名为Employee的类模块，其代码如下：

 Option Explicit Public Name As String Public City As String Public Title As String 

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

 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数据types…因为它只是一个数据types而不是一个对象。 在这种情况下，你必须遍历索引（索引？）：

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

但是，如果使用VBA已知的对象，比如Range：

 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对象一样使用对象来循环访问集合。 我参考的链接解释了可能有的问题以及创build自己的Collection对象的解决scheme。