arrays - 将集合的值复制到 VBA 中的二维数组

Question

我似乎正在撞着众所周知的砖墙。我有一个运行并填充集合的循环。大约有 20000 行和 11 列。我需要能够将集合的内容放入一个变体数组中，以便我可以批量复制到工作表。我使用集合的原因是条目的固有重复数据删除。

请有人就如何实现这一目标提出建议。我假设我遗漏了一些简单的东西，但如果我不使用集合，我需要对 200k+ 行进行重复数据删除。

提前感谢您的所有帮助

编辑

这是实际的代码。正如我上面提到的，问题不在于将数据放入集合(MyCollection)中，而是将其再次取出!

编辑

数据流从一个工作表开始，然后将其复制到一个名为 ArrayOrg 的数组中。循环遍历数组，当满足某些条件时，将一条记录添加到 ArrayOrg1 数组中。请看下面的代码。

    For intI = 1 To UBound(ArrayOrg())
            If ArrayOrg(intI, 7) = "cMat" And ArrayOrg(intI, 5) = "Plant" Then

                ArrayOrg1_cMat(Org1Count_cMat, 0) = ArrayOrg(intI, 1)           'User ID
                ArrayOrg1_cMat(Org1Count_cMat, 1) = ArrayOrg(intI, 2)           'BR ID
                ArrayOrg1_cMat(Org1Count_cMat, 2) = ArrayOrg(intI, 3)           'Scenario
                ArrayOrg1_cMat(Org1Count_cMat, 3) = ArrayOrg(intI, 4)           'Role
                ArrayOrg1_cMat(Org1Count_cMat, 4) = ArrayOrg(intI, 5)           'Controlling Field
                ArrayOrg1_cMat(Org1Count_cMat, 5) = ArrayOrg(intI, 6)           'Controlling Field Value
                ArrayOrg1_cMat(Org1Count_cMat, 6) = ArrayOrg(intI, 7)           'Webapp
                Org1Count_cMat = Org1Count_cMat + 1
Next intI

Dim MyCollection As Collection
    Dim ArrayTemp() As Variant
    Set MyCollection = New Collection  

    For intI = 0 To UBound(ArrayOrg1_cMat())
        For intJ = 0 To UBound(ArrayOrg2_cMat())
                If ArrayOrg2_cMat(intJ, 0) = ArrayOrg1_cMat(intI, 0) Then
                        If ArrayOrg2_cMat(intJ, 1) = ArrayOrg1_cMat(intI, 1 Then                             If ArrayOrg2_cMat(intJ, 2) = ArrayOrg1_cMat(intI, 2) Then                                 If ArrayOrg2_cMat(intJ, 3) = ArrayOrg1_cMat(intI, 3) Then                                     

                                    ArrayTemp(0, 0) = ""                                    'Name
                                    ArrayTemp(0, 1) = ArrayOrg1_cMat(intI, 0)               'AD ID
                                    ArrayTemp(0, 2) = ""                                    'Email
                                    ArrayTemp(0, 3) = ""                                     'Requester
                                    ArrayTemp(0, 4) = ArrayOrg1_cMat(intI, 6)               'Webapp
                                    ArrayTemp(0, 5) = ArrayOrg1_cMat(intI, 2)               'Scenario
                                    ArrayTemp(0, 6) = ArrayOrg1_cMat(intI, 3)               'Role
                                    ArrayTemp(0, 7) = "PL"                                 'Business Unit
                                    ArrayTemp(0, 8) = "NONE"
                                    ArrayTemp(0, 9) = "NONE"
                                    ArrayTemp(0, 10) = "NONE"
                                    ArrayTemp(0, 11) = ArrayTemp(0, 0) & ArrayTemp(0, 1) & ArrayTemp                                              (0, 2) & ArrayTemp(0, 3) & ArrayTemp(0, 4) _
                                                      & ArrayTemp(0, 5) & ArrayTemp(0, 6) & ArrayTemp                                                 (0, 7) & ArrayTemp(0, 8) & ArrayTemp(0, 9) _
                                                      & ArrayTemp(0, 10) '### This is the key for the collection

                                    On Error Resume Next
                                    MyCollection.Add ArrayTemp, ArrayTemp(0, 11)
                                    On Error GoTo 0                                    
                                End If
                            End If
                        End If
                End If
        Next intJ
    Next intI
'#### THIS IS WHERE THE PROBLEM IS
For intI = 0 To MyCollection.Count  
    ArrayOutput(intI, 0) = MyCollection.Item(intI)  
Next intI  

谢谢
凯文

Answer 1

Sub Tester()

Dim k As String
Dim i As Long, j As Long, r As Long, x As Long
Dim arr() As Variant
Dim dict

    ReDim arr(1 To UBound(ArrayOrg1_cMat, 1) + 1, 1 To 11)
    r = 0
    Set dict = CreateObject("scripting.dictionary")

    For i = 0 To UBound(ArrayOrg1_cMat())
        For j = 0 To UBound(ArrayOrg2_cMat())

            If ArrayOrg2_cMat(j, 0) = ArrayOrg1_cMat(i, 0) Then
            If ArrayOrg2_cMat(j, 1) = ArrayOrg1_cMat(i, 1) Then
            If ArrayOrg2_cMat(j, 2) = ArrayOrg1_cMat(i, 2) Then
            If ArrayOrg2_cMat(j, 3) = ArrayOrg1_cMat(i, 3) Then

                ' I'm skipping the constant values in your original key...
                k = Join(Array(ArrayOrg1_cMat(i, 0), _
                               ArrayOrg1_cMat(i, 6), _
                               ArrayOrg1_cMat(i, 2), _
                               ArrayOrg1_cMat(i, 3)), "~")

                If Not dict.exists(k) Then
                    r = r + 1
                    dict.Add k, True
                    arr(r, 1) = ""                   'Name
                    arr(r, 2) = ArrayOrg1_cMat(i, 0) 'AD ID
                    arr(r, 3) = ""                   'Email
                    arr(r, 4) = ""                   'Requester
                    arr(r, 5) = ArrayOrg1_cMat(i, 6) 'Webapp
                    arr(r, 6) = ArrayOrg1_cMat(i, 2) 'Scenario
                    arr(r, 7) = ArrayOrg1_cMat(i, 3) 'Role
                    arr(r, 8) = "PL"                 'Business Unit
                    arr(r, 9) = "NONE"
                    arr(r, 10) = "NONE"
                    arr(r, 11) = "NONE"
                End If


            End If
            End If
            End If
            End If

        Next j
    Next i

    ActiveSheet.Range("a2").Resize(r, 11).Value = arr

End Sub