2

ことわざのレンガの壁に前をぶつけているようです。コレクションを実行してデータを取り込むループがあります。約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

ありがとうケビン

4

1 に答える 1

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
于 2013-03-19T00:54:28.810 に答える