这是一个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
答案 0 :(得分: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对象的解决方案。
答案 1 :(得分:1)
根据您的评论,这是另一个答案。我想这就是你要找的东西。如果没有,请更具描述性并修改您的问题。
您有一个名为Employee的类模块,其代码为:
Option Explicit
Public Name As String
Public City As String
Public Title As String
然后,在常规模块中,您可以使用下面的内容。密切关注示例并根据您的需要进行修改。我把Sort代码留了下来,所以你可以自己试一试。另外,请注意我如何将工作拆分为单独的函数/ subs。这可以使您的代码保持清洁,更易于遵循。希望这会有所帮助。
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