0

这是一个 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

更新

根据约瑟夫的回答，这就是我尝试过的。我还没有让它工作。

这是我一直在搞砸的几个不同的潜艇。他们都试图解决同样的问题。

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
4

2 回答 2

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 已知的对象，例如 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 对象所做的那样。我引用的链接解释了可能存在的问题以及创建自己的 Collection 对象的解决方案。

于 2013-04-15T19:44:34.323 回答
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
于 2013-04-17T16:10:12.347 回答