集合的值复制到VBA二维数组 [英] Copy the values of a collection to a 2D array in VBA
本文介绍了集合的值复制到VBA二维数组的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我似乎在敲打我对众所周知的砖墙领先。我有它运行并填充集合的循环。有大约20000行和11列。我需要能够获得集合的内容到一个变量数组，这样我可以做一个大容量复制到工作表。我使用的是集合的原因是项目的固有的重复数据删除。
请会有人给您一个建议就如何实现这一目标。我以为我失去了一些东西简单，但如果我不使用集合，我需要20万dedupliate +行。
在此先感谢您的帮助。
修改
下面是实际code。正如我上面提到的，这个问题是没有得到数据到集合（myCollection）将其再次得到它！
修改
数据的流程开始工作表中，然后复制到名为ArrayOrg阵列。该阵列是通过环和当某些条件满足时，一个记录被添加到所述ArrayOrg1阵列。请参阅下面的code。
有关INTI = 1到UBound函数（ArrayOrg（））
如果ArrayOrg（INTI，7）=CMAT和ArrayOrg（INTI，5）=植物然后 ArrayOrg1_cMat（Org1Count_cMat，0）= ArrayOrg（INTI，1）'用户ID
ArrayOrg1_cMat（Org1Count_cMat，1）= ArrayOrg（INTI，2）BR ID
ArrayOrg1_cMat（Org1Count_cMat，2）= ArrayOrg（INTI，3）方案
ArrayOrg1_cMat（Org1Count_cMat，3）= ArrayOrg（INTI，4）的角色
ArrayOrg1_cMat（Org1Count_cMat，4）= ArrayOrg（INTI，5）控制字段
ArrayOrg1_cMat（Org1Count_cMat，5）= ArrayOrg（INTI，6）控制字段值
ArrayOrg1_cMat（Org1Count_cMat，6）= ArrayOrg（INTI，7）'的webapp
Org1Count_cMat = Org1Count_cMat + 1
接下来INTI昏暗的MyCollection的为集合
昏暗ArrayTemp（）为Variant
集MyCollection的=新集合 对于INTI = 0到UBound函数（ArrayOrg1_cMat（））
对于INTJ = 0到UBound函数（ArrayOrg2_cMat（））
如果ArrayOrg2_cMat（INTJ，0）= ArrayOrg1_cMat（INTI，0），则
如果ArrayOrg2_cMat（INTJ，1）= ArrayOrg1_cMat（INTI，1 Then如果ArrayOrg2_cMat（INTJ，2）= ArrayOrg1_cMat（INTI，2）然后，如果ArrayOrg2_cMat（INTJ，3）= ArrayOrg1_cMat（INTI，3）然后 ArrayTemp（0,0）='名称
ArrayTemp（0,1）= ArrayOrg1_cMat（INTI，0）AD ID
ArrayTemp（0,2）=电子邮件
ArrayTemp（0,3）='请求者
ArrayTemp（0,4）= ArrayOrg1_cMat（INTI，6）'的webapp
ArrayTemp（0,5）= ArrayOrg1_cMat（INTI，2）方案
ArrayTemp（0，6）= ArrayOrg1_cMat（INTI，3）的角色
ArrayTemp（0,7）=PL'业务部
ArrayTemp（0,8）=无
ArrayTemp（0,9）=无
ArrayTemp（0，10）=无
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）'###这是用于集合的键 在错误恢复下一页
MyCollection.Add ArrayTemp，ArrayTemp（0，11）
对错误转到0
万一
万一
万一
万一
接下来INTJ
接下来INTI
####这就是问题
对于INTI = 0到MyCollection.Count
ArrayOutput（INTI，0）= MyCollection.Item（INTI）
接下来INTI
谢谢
凯文
解决方案
子仪（）昏暗的K作为字符串
昏暗我只要，J只要河长中，x只要
昏暗ARR（）为Variant
昏暗的字典 REDIM ARR（1至UBound函数（ArrayOrg1_cMat，1）+ 1，1到11）
R = 0
设置字典=的CreateObject（的Scripting.Dictionary） 对于i = 0到UBound函数（ArrayOrg1_cMat（））
对于j = 0要UBound函数（ArrayOrg2_cMat（）） 如果ArrayOrg2_cMat（J，0）= ArrayOrg1_cMat（I，0）然后
如果ArrayOrg2_cMat（J，1）= ArrayOrg1_cMat（I，1）。然后
如果ArrayOrg2_cMat（J，2）= ArrayOrg1_cMat（I，2）然后
如果ArrayOrg2_cMat（J，3）= ArrayOrg1_cMat（I，3）然后 我跳过你的原来的键常数值...
K =加入（阵列（ArrayOrg1_cMat（I，0），_
ArrayOrg1_cMat（ⅰ，6），_
ArrayOrg1_cMat（I，2），_
ArrayOrg1_cMat（I，3）），〜） 如果不dict.exists（K）然后
R = R + 1个
dict.Add K，真
ARR（R，1）='名称
ARR（R，2）= ArrayOrg1_cMat（I，0）AD ID
ARR（R，3）=电子邮件
ARR（R，4）='请求者
ARR（R，5）= ArrayOrg1_cMat（I，6）'的webapp
ARR（R，6）= ArrayOrg1_cMat（I，2）'情景
ARR（R，7）= ArrayOrg1_cMat（I，3）'的作用
ARR（R，8）=PL'业务部
ARR（R，9）=NONE
ARR（R，10）=NONE
ARR（R，11）=NONE
万一
万一
万一
万一
万一 下面j
接下来，我 ActiveSheet.Range（A2）。调整（R，11）.value的ARR =结束小组
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屋！
查看全文
