爲什麼我的收藏空白？

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對象的解決方案。