无法解决的谜团。我一直在运行时遇到＆＃34;类型不匹配＆＃34; 错误。
我正在尝试比较从两个不同表格中提取的两个2D数组，以循环和比较＆＃34;切片＆＃34;这些数组是逐行的。如果找到匹配，则应将一个数组中的值分配给另一个数组的空（null）索引。
这是我的代码：
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
以下是第一个数组＆＃39; arrPlan＆＃39; 的示例：
约80行，15列;字符串和int;没有空（null）值
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
以下是第二个数组的示例＆＃39; arrRawData＆＃39; ：
约400,000行，13列;字符串和一些空（null）单元格
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在某个行号之上不起作用吗？最终目标是将 arrPlan 中的数字（数量从列jan，feb，mar，...开始）到空的极右栏＆＃39;计划NET＆＃39 ; arrRawData 数组并将其全部写回工作表。
感谢您拯救我的理智。
答案 0 :(得分：1)
您不能使用单个操作比较两个数组：您需要循环两个数组并比较每对元素，或者将两个数组减少为单个值。
E.g。使用Join() -
Sub Test()
Dim arrPlan, arrRawData, i, j, v1, v2
Set arrPlan = Range("A3:J8")
Set arrRawData = Range("A11:J16")
i = 1
j = 2
v1 = Application.WorksheetFunction.Index(arrPlan, i, Array(1, 2, 3, 4, 5))
v2 = Application.WorksheetFunction.Index(arrRawData, j, Array(1, 6, 7, 8, 10))
If Join(v1, vbNull) = Join(v2, vbNull) Then
Debug.Print "match!"
End If
End Sub
修改 - 由于您拥有大量数据，因此下面的方法会明显加快。它为每个范围创建字典“地图”，每个范围具有由每个范围中的一个或多个列组成的“键”。
然后简单/快速地查找行匹配，因为您需要做的就是从其中一个映射循环键（循环遍历较小的映射）并使用每个键在另一个（较大）映射上调用“exists”。
Sub Test()
Dim d1, d2, k
Set d1 = RowMap(Range("A3:J8"), Array(1, 2, 3))
Set d2 = RowMap(Range("A11:J16"), Array(8, 9, 10))
Debug.Print d1.Count, d2.Count
For Each k In d1.keys
If d2.exists(k) Then
Debug.Print "Found a match on " & k & ": " & _
d1(k).Address & " to " & d2(k).Address
End If
Next k
End Sub
'Get a "map" of row keys (composed of one or more columns) to the
' rows where they are located (just maps the first cell in each row)
' "rng" is the range to be mapped
' "arrcols" is an array of column numbers to use for the [composite] key
Function RowMap(rng As Range, arrCols)
Dim rv, nr As Long, nc As Long, r As Long, c As Long
Dim k, lbc As Long, ubc As Long, sep As String
Dim data
Set rv = CreateObject("scripting.dictionary")
data = rng.Value
lbc = LBound(arrCols)
ubc = UBound(arrCols)
For r = 1 To UBound(data, 1)
sep = ""
k = ""
For c = lbc To ubc
k = k & sep & data(r, arrCols(c))
If c = lbc Then sep = Chr(0)
Next c
If rv.exists(k) Then
Set rv(k) = Application.Union(rv(k), rng.Columns(1).Cells(r))
Else
rv.Add k, rng.Columns(1).Cells(r)
End If
Next r
Set RowMap = rv
End Function
答案 1 :(得分：0)
使用Scripting.Dictionary对象尝试此修改。
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)。循环必须在UBound或其他运行时错误9之间停止11：当+11超过UBound时，下标将超出范围。
编辑 - 两次修改