VBA比较两个二维数组（行），VBA抛出＆QUOT;类型不匹配＆QUOT ;,声明确定 [英] VBA Comparing two 2D arrays (rows), VBA throws "Type mismatch", declarations ok
问题描述
无解之谜。我不断收到类型不匹配运行时错误。
Unsolvable mystery. I keep getting "Type mismatch" error at runtime.
我想按行来比较两个二维数组，从两个不同的表解除，循环和比较这些阵列的片，一行。如果找到匹配，从一个阵列值应分配给其他的阵列的空（零）的索引。
I am trying to compare two 2D arrays, lifted from two different Sheets, to loop and compare "slices" of these arrays, row by row. If match is found, values from one array should be assigned to empty (null) indexes of the other array.
这是我的code：
Private arrPlan() As Variant
Private lastRowSource As Long
Private lastColSource As Long
Private arrRawData() As Variant
Private lastRowDestination As Long
Private lastColDestination As Long
Public Sub Get_Plan_Into_RawData()
'---- Find last row/col and read Excel ranges into Arrays
lastRowSource = Sheet1.Range("A" & Rows.count).End(xlUp).Row
lastColSource = Sheet1.Range("A1").End(xlToRight).Column
lastColDestination = Sheet2.Range("A1").End(xlToRight).Column
lastRowDestination = Sheet2.Range("A" & Rows.count).End(xlUp).Row
arrPlan = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRowSource, lastColSource))
arrRawData = Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(lastRowDestination, lastColDestination))
'----- Compare arrays, assign amounts from one array to the other
For i = LBound(arrPlan, 1) + 1 To UBound(arrPlan, 1)
For j = LBound(arrRawData, 1) + 1 To UBound(arrRawData, 1)
If Application.WorksheetFunction.Index(arrPlan, i, Array(1, 2, 3, 4, 5)) = _
Application.WorksheetFunction.Index(arrRawData, j, Array(1, 6, 7, 8, 10)) Then
arrRawData(j, 12) = arrPlan(i, 6)
arrRawData(j + 1, 12) = arrPlan(i, 7)
arrRawData(j + 2, 12) = arrPlan(i, 8)
arrRawData(j + 3, 12) = arrPlan(i, 9)
arrRawData(j + 4, 12) = arrPlan(i, 10)
arrRawData(j + 5, 12) = arrPlan(i, 11)
arrRawData(j + 6, 12) = arrPlan(i, 12)
arrRawData(j + 7, 12) = arrPlan(i, 13)
arrRawData(j + 8, 12) = arrPlan(i, 14)
arrRawData(j + 9, 12) = arrPlan(i, 15)
arrRawData(j + 10, 12) = arrPlan(i, 16)
arrRawData(j + 11, 12) = arrPlan(i, 17)
GoTo 10
End If
Next j
10 Next i
End Sub
这是第一个数组的例子arrPlan
80行，15列;字符串和INT的;没有空（NULL）值
about 80 rows, 15 columns; strings and int's; no empty (null) values
Market Channel Campaign Product Funding source jan feb mar apr may jun
Austria sem np A. v. dp 1,078.14 658.24 703.85 10,504.94 9,631.14 10,345.06
Austria sem np Culture dp 1,660.86 1,139.12 1,098.52 16,182.72 16,667.23 16,145.70
这里是第二个数组的例子arrRawData
约40行，13列;字符串和一些空（NULL）细胞
about 400,000 rows, 13 columns; strings and some empty (null) cells
Market Code Priority Abbreviation Translation Channel Campaign Product P. code Funding src. Month plan NET
Austria 4 4 AT Austrija gdn advent Family vacation 0 bp jan
Austria 4 4 AT Austrija gdn advent Family vacation 0 bp feb
- 也可以是
WorksheetFunction.Index不工作超过一定行数？ - 在的arrRawData'present问题的一些指标的空值？
- Can it be that
WorksheetFunction.Indexdoes not work above certain row number? - The "Empty" values in some indexes of 'arrRawData' present the problem?
的最终目标是从获取数字（金额形式的专栏一月，二月，三月，...） arrPlan 入空最右列的规划NET在 arrRawData 阵列和它的所有写回表。
The final goal is to get numbers (amounts form columns jan, feb, mar, ...) from arrPlan into the empty far right column 'plan NET' of the arrRawData array and write it all back to the Sheet.
谢谢你救了我的理智。
推荐答案
Try this modification using a Scripting.Dictionary object.
Public Sub Get_Plan_Into_RawData()
Dim a As Long, d As Long, arrPlan As Variant, arrRawData As Variant
Dim dPlan As Object
Set dPlan = CreateObject("Scripting.Dictionary")
dPlan.comparemode = vbTextCompare
With Sheet1
With .Cells(1, 1).CurrentRegion
arrPlan = .Cells.Value2
End With
Debug.Print LBound(arrPlan, 1) & ":" & UBound(arrPlan, 1)
Debug.Print LBound(arrPlan, 2) & ":" & UBound(arrPlan, 2)
For d = LBound(arrPlan, 1) + 1 To UBound(arrPlan, 1)
If Not dPlan.exists(Join(Array(arrPlan(d, 1), arrPlan(d, 2), arrPlan(d, 3), _
arrPlan(d, 4), arrPlan(d, 5)), ChrW(8203))) Then
dPlan.Add Key:=Join(Array(arrPlan(d, 1), arrPlan(d, 2), arrPlan(d, 3), _
arrPlan(d, 4), arrPlan(d, 5)), ChrW(8203)), _
Item:=d
End If
Next d
End With
With Sheet2
With .Cells(1, 1).CurrentRegion
arrRawData = .Cells.Value2
End With
Debug.Print LBound(arrRawData, 1) & ":" & UBound(arrRawData, 1)
Debug.Print LBound(arrRawData, 2) & ":" & UBound(arrRawData, 2)
End With
'a) cannot loop to the end if you are going to add 11
'b) if you are putting values into 12 consecutive rows,
' then why not Step 12 on the increment
For a = LBound(arrRawData, 1) + 1 To UBound(arrRawData, 1) - 11 Step 12
If dPlan.exists(Join(Array(arrRawData(a, 1), arrRawData(a, 6), arrRawData(a, 7), _
arrRawData(a, 8), arrRawData(a, 10)), ChrW(8203))) Then
d = dPlan.Item(Join(Array(arrRawData(a, 1), arrRawData(a, 6), arrRawData(a, 7), _
arrRawData(a, 8), arrRawData(a, 10)), ChrW(8203)))
arrRawData(a, 12) = arrPlan(d, 6)
arrRawData(a + 1, 12) = arrPlan(d, 7)
arrRawData(a + 2, 12) = arrPlan(d, 8)
arrRawData(a + 3, 12) = arrPlan(d, 9)
arrRawData(a + 4, 12) = arrPlan(d, 10)
arrRawData(a + 5, 12) = arrPlan(d, 11)
arrRawData(a + 6, 12) = arrPlan(d, 12)
arrRawData(a + 7, 12) = arrPlan(d, 13)
arrRawData(a + 8, 12) = arrPlan(d, 14)
arrRawData(a + 9, 12) = arrPlan(d, 15)
arrRawData(a + 10, 12) = arrPlan(d, 16)
arrRawData(a + 11, 12) = arrPlan(d, 17)
End If
Next a
'put the revisions back
With Sheet2
.Cells(1, 1).Resize(UBound(arrRawData, 1), UBound(arrRawData, 2)) = arrRawData
End With
dPlan.RemoveAll: Set dPlan = Nothing
End Sub
在转移的价值观，你被传递到阵列中的连续行，但仍试图处理到 UBound函数（arrRawData，1）。循环必须停止11短UBound函数或其他运行时错误9：下标越界了将要发生时， +11 推过去的 UBound函数
When transferring the values, you were passing into successive 'rows' in the array but still trying to process to UBound(arrRawData, 1). The loop has to stop 11 short of the UBound or another Runtime error 9: Subscript out of range was going to occur when the +11 pushed past the UBound.
编辑： - 两处修改
- 填充字典的原始方法是一个覆盖方法，但它发生，我认为你总是需要第一个匹配的位置。改变了。新增方法。
- 通过较大的阵列循环应该是在第12步的增量，因为你是填充与匹配数据连续12行。
这篇关于VBA比较两个二维数组（行），VBA抛出＆QUOT;类型不匹配＆QUOT ;,声明确定的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
