将集合的值复制到 VBA 中的二维数组 [英] Copy the values of a collection to a 2D array in VBA
问题描述
I seem to be banging my ahead against the proverbial brick wall. I have a loop which runs and populates a collection. There are approximately 20000 rows and 11 columns. I need to be able to get the contents of the collection into a variant array so that I can do a bulk copy to a worksheet. The reason I was using a collection is for the inherent de-duplication of entries.
Please could someone offer a suggestion as to how to achieve this. I assume I am missing something straightforward but if I dont use a collection I need to dedupliate 200k+ rows.
Thanks in advance for all your help
EDIT
Here is the actual code. As I mentioned above, the problem is not getting the data into the collection (MyCollection), its getting it out again!
EDIT
The flow of data starts in a worksheet which is then copied into an array called ArrayOrg. The array is looped through and when certain conditions are satisfied, a record is added to the ArrayOrg1 array. Please see the code below.
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
Thanks Kevin
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
这篇关于将集合的值复制到 VBA 中的二维数组的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!