Question

我是VBA的新手，正在挑选作品。我在理解创建的集合时遇到问题，然后循环遍历它以一次读取每个键的值。我的代码如下。

Excel数据我正在使用数据

可以说，运行模块时我在Excel 2016中遇到的错误是：

按Debug显示

我试图按键打印值。我预计要打印80,20等。有人可以请帮助我理解为什么我在编写dataItems时出错，以及如何解决这个问题，因此它会再次打印键值 - 我怀疑它是一个需要的for循环。

任何帮助都将不胜感激。

代码I使用：

班级：CItems

Option Explicit

Public Key As String
Public Sum As Long
Public Count As Long
Public ItemList As Collection
Public Function Mean() As Double
    Mean = Sum / Count
End Function
Private Sub Class_Initialize()
    Sum = 0
    Count = 0
    Set ItemList = New Collection
End Sub

模块：m_Call

Option Explicit

Sub m_Call()

''' Create Collection from Column A and B in worksheet called RAW_DATA

Dim col As Collection
Dim dataItems As cItems
Dim itemKey As String
Dim item1 As Long
Dim ws As Worksheet
Dim r As Long

Set ws = ThisWorkbook.Worksheets("RAW_DATA")
Set col = New Collection

For r = 2 To 3000
    itemKey = CStr(ws.Cells(r, "A").Value2) '~~adjust to your own column(s)
    item1 = CLng(ws.Cells(r, "B").Value2) '~~adjust to your own column(s)

    'Check if key already exists
    Set dataItems = Nothing: On Error Resume Next
    Set dataItems = col(itemKey): On Error GoTo 0

    'If key doesn't exist, create a new class object
    If dataItems Is Nothing Then
        Set dataItems = New cItems
        dataItems.Key = itemKey
        col.Add dataItems, itemKey
    End If

    'Add cell values to the class object
    With dataItems
        .Sum = .Sum + item1
        .Count = .Count + 1
        .ItemList.Add item1
    End With

Next

'Iterating through all of the items
Dim i As Long
i = 5
For Each dataItems In col

    Debug.Print dataItems.Mean
    ws.Cells(5, i) = dataItems.Key
    ' read in column 5 and check search each cells content to see if it matches a collection key's string.
    i = i + 1
Next

'Selecting one item
'Set dataItems = col("PersonA 1")


'ws.Cells(4, 5) = dataItems.Mean


''' Read excel and populate categories if the value in a column A cell matches with a key in the Collection.
''' Column 10 and 11 should have the values that match each Key inserted respectively.

    Dim cols As Range
    Dim rng As Range
    Dim currentRow As Long
    Dim category As Variant



    ' Use a  With block to 'Fully Qualify' the ranges to MySheet
    With ThisWorkbook.Sheets("RAW_DATA")
        ' Set col range to the intersection of used range and column B
        Set cols = Intersect(.UsedRange, .Columns("A"))
        ' Loop through cells in cols to set description in each row
        For Each rng In cols
            currentRow = rng.Row
            ' Read in key's from collection
            For Each dataItems In col
                ' read in column and search each cells content to see if it matches a collection key's string.
                .Cells(currentRow, 10) = rng.Value
                If rng.Value = dataItems.Key Then
                    .Cells(currentRow, 10) = "Working"
                    'Debug.Print dataItems
                    '''Need to insert value1 from key into Column 10 and value2 from same key into column 11.
                    ''' I'm just testing to see if I can insert a single category first before working on the loop.
                    .Cells(currentRow, 10) = "Shopping"
                    .Cells(currentRow, 11) = dataItems
                End If
            Next

        Next rng
    End With

''' End of Read excel

End Sub

Answer 1

我真的无法得到你想要达到的目标。另外，我有一个模糊的想法，就是你正在过度思考你的问题。考虑到这些问题，请尝试以下操作，看看它是否对您有所帮助。

If rng.Value = dataItems.Key Then
    .Cells(currentRow, 10) = "Working"
    'Debug.Print dataItems
    '''Need to insert value1 from key into Column 10 and value2 from same key into column 11.
    ''' I'm just testing to see if I can insert a single category first before working on the loop.
    .Cells(currentRow, 10) = "Shopping"
    For k = 1 To dataItems.Count
        .Cells(currentRow, k + 11) = dataItems.ItemList(k)
    Next
End If

另外，尝试使用Watch Window，添加dataItems作为检查变量。在代码中插入一个断点（例如在If rng.Value = dataItems.Key Then中），然后继续使用F8。

循环每个vba集合，使变量类型冲突失败

1 个答案: