Почему моя коллекция пустая?

Question

Это сценарий VBA. Я не уверен, почему моя коллекция не заполняет лист «By Market».

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

ответ на Иосифе, вот что я пробовал. Пока у меня нет работы.

Вот несколько разных подписчиков, с которыми я возился. Они все пытаются решить ту же проблему.

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 

Затем в обычном модуле, вы можете иметь что-то, как показано ниже. Обратите особое внимание на пример и измените его для своих нужд. Я оставил код сортировки, чтобы вы могли сделать это сами. Также обратите внимание на то, как я разбил работу на отдельные функции/подсистемы. Это упрощает и упрощает ваш код. Надеюсь это поможет.

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

EDIT: Для того, чтобы ответить на ваш комментарий:

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 

Это не потому, что вы не можете перебрать с помощью строкового типа данных ... потому что это просто тип данных, а не объект. В этом случае, вы должны перебрать индексы (индексы):

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.