首页 > 解决方案 > 如何阅读 vba 中的 Collections 元素?

问题描述

我已经创建了名为 AllCollection 的集合,并从工作表“All”中的范围分配了数据。现在我正在尝试比较集合 (i) 和元素 (i,1) 中的值,但是我无法找出正确的语法。我尝试过无数种形式,比如 AllCollection(i)(i, 1) 或 AllCollection(i(i, 1)) 都没有运气。我没有使用数组,因为我不知道 OP3Collection 和 NewCollection 的大小。

Dim OP3Collection As New Collection
Dim NewCollection As New Collection
Dim AllCollection As New Collection
...
some other code
...
AllCollection.Add Sheets("All").Range("A2:AL" & LastRow).Value
LastRowC = 0
For i = 1 To LastRow - 1
    If AllCollection.Item1(i).Items1(i, 1) = "*" Then
        NewCollection.Add AllCollection.Item(i)
    ElseIf AllCollection.Item1(i).Items1(i, 1) = 3 Then
        OP3Collection.Add AllCollection.Item(i)
    End If
    Str = "Split: Copying data from sheet /All/ to sheets /New/,/OldPop3/ "
    Call ProgressOfCode(i, LastRow - 1, Str)
    Str = ""
Next
LastRowC = NewCollection.Count
Sheets("New").Range("A2:AL" & LastRowC + 1).Value = NewCollection
LastRowC = OP3Collection.Count
Sheets("OldPop3").Range("A2:AL" & LastRowC + 1).Value = OP3Collection
...

标签: excelvba

解决方案


如果有人想知道类似的问题,我用数组编写了不同的代码,那要快得多。

NewArray = Sheets("All").Range("A2:AL" & LastRow).Value
OP3Array = Sheets("All").Range("A2:AL" & LastRow).Value
For i = 1 To LastRow - 1
    If NewArray(i, 1) <> "*" Then
        For j = 1 To 38
            NewArray(i, j) = Empty
        Next
    End If
    If OP3Array(i, 1) <> 3 Then
        For j = 1 To 38
            OP3Array(i, j) = Empty
        Next
    End If
    Str = "Split: Copying data from sheet /All/ to sheets /New/,/OldPop3/ "
    Call ProgressOfCode(i, LastRow - 1, Str)
    Str = ""
Next

ArraySize = UBound(NewArray)
Sheets("New").Range("A2:AL" & ArraySize + 1).Value = NewArray
'Sorts and pushes empty rows to bottom
Sheets("New").Range("A2:AL" & ArraySize + 1).Sort 
Key1:=Sheets("New").Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

ArraySize = UBound(OP3Array)
Sheets("OldPop3").Range("A2:AL" & ArraySize + 1).Value = OP3Array
'Sorts and pushes empty rows to bottom
Sheets("OldPop3").Range("A2:AL" & ArraySize + 1).Sort 
Key1:=Sheets("OldPop3").Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

推荐阅读