如何比较两行核算通配符的数据

Question

我想比较两组行，表中的数据"计算结构"；与来自表"1"的数据进行比较；MAP"；如果匹配，则返回最后一列中的值。

基于其他响应，我有以下代码，它将行连接到一个字符串中，然后利用dictionary来执行比较。我正在使用dictionary来提高性能，因为我正在比较MAP和DATA，它们都是50000+条记录。

Sub CheckRows()
Dim cl As Range
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Vlu As String
Dim VluD As String
Dim Lc As Long
Dim x As Long
Dim i As Long
Dim ArrRslt() As Variant
Dim iRw As Long
Dim LastRow As Long
Dim RngTrgt As Range
Dim dict As New Scripting.Dictionary
Set Ws1 = Sheets("Calculated Structure")
Set Ws2 = Sheets("Map")
Lc = Ws2.Cells(2, Columns.Count).End(xlToLeft).Column - 1
RsltCol = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
For icntr = RsltCol To 1 Step -1
If Cells(1, icntr).value = "Calced Result" Then
Columns(icntr).Delete
End If
Next
LastCol = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Cells(1, LastCol + 1).value = "Calced Result"
i = 1
x = 1
ReDim ArrRslt(0)

With CreateObject("scripting.dictionary")
dict.CompareMode = 1
For Each cl In Ws2.Range("A1", Ws2.Range("A" & Rows.Count).End(xlUp))
Vlu = Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
dict.Add key:=Vlu, Item:=(Ws2.Cells(i, Lc + 1))
i = i + 1
Next cl

For Each cl In Ws1.Range("B2", Ws1.Range("B" & Rows.Count).End(xlUp))
VluD = Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
If dict.Exists(VluD) Then 
CResult = dict(VluD)
ArrRslt(x - 1) = CResult
Else
ArrRslt(x - 1) = "?"
End If
ReDim Preserve ArrRslt(0 To x)
x = x + 1
Next cl
End With
LastRow = Ws1.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set RngTrgt = Ws1.Range(Cells(2, Lc + 2), Cells(LastRow, Lc + 2))
RngTrgt = Application.WorksheetFunction.Transpose(ArrRslt)
MsgBox "Mapping Complete!"
End Sub

一些实例在"；MAP"；具有被指定为单元值的通配符("*"(。

例如，MAP看起来像：

结果

检查1	检查2	检查3
ABC	DEF	123	R1
ABC

我尝试了嵌套字典。我相信我能够分配适当的值，但在尝试从字典中检索信息时会遇到运行时错误"450"。这是我的代码：

Sub theDictionary()
Dim cl As Range
Dim WsRslt As Worksheet
Dim WsMap As Worksheet
Dim Vlu As String
Dim VluD As String
Dim Lc As Long
Dim MapVl As Long
Dim RsltCol As Long
Dim icntr As Long
Dim LastCol As Long
Dim rCount As Long
Dim mCount As Long
Dim x As Long
Dim i As Long
Dim dictCount As Long
Dim ArrRslt() As Variant
Dim iRw As Long
Dim LastRow As Long
Dim previousCell As String
Dim cResult As String
Dim RngTrgt As Range
Dim dict As New Scripting.Dictionary
Dim subDict() As Object
Set WsRslt = Sheets("Calculated Structure")
Set WsMap = Sheets("Map")
MapVl = WsMap.Cells(2, Columns.Count).End(xlToLeft).Column
Lc = MapVl - 1

MsgBox "Map value=" & MapVl & "and LC=" & Lc

RsltCol = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

For icntr = RsltCol To 1 Step -1
If Cells(1, icntr).value = "Calced Result" Then
Columns(icntr).Delete
End If
Next


LastCol = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

Cells(1, LastCol + 1).value = "Calced Result"

i = 1
x = 1
dictCount = 1
rCount = 1
ReDim ArrRslt(0)
previousCell = ""

ReDim subDict(1 To MapVl - 1)
For dictCount = 1 To MapVl - 1
Set subDict(dictCount) = New Scripting.Dictionary
subDict(dictCount).CompareMode = vbTextCompare
Next dictCount
For Each cl In WsMap.Range("A2", WsMap.Range("A" & Rows.Count).End(xlUp))
For rCount = 1 To MapVl - 1
'get the first item and add it to the subdictionary
'            MsgBox "MapVl=" & MapVl & " and rCount=" & rCount
If rCount = 1 Then
If subDict(rCount).Exists(cl.Offset(0, MapVl - (rCount + 1)).Value2) Then
'                    MsgBox cl.Offset(0, MapVl - (rCount + 1)) & " Exists"
Else
'                    MsgBox cl.Offset(0, MapVl - (rCount + 1)) & " First Add"
subDict(rCount).Add CStr(cl.Offset(0, MapVl - (rCount + 1)).Value2), CStr(cl.Offset(0, MapVl - rCount).Value2)
End If
ElseIf rCount < MapVl Then
subDict(rCount).Add CStr(cl.Offset(0, MapVl - (rCount + 1)).Value2), subDict(rCount - 1)
End If
'                    MsgBox "Prev Cell Blank=" & previousCell & "cl.value=" & cl.value
Next rCount
rCount = 1
Next cl

For Each cl In WsRslt.Range("B2", WsRslt.Range("B" & Rows.Count).End(xlUp))
For mCount = 1 To MapVl - 1
VluD = cl.Value2 'Join(Application.Index(cl.RESIZE(, Lc).value, 1, 0), "|")
MsgBox "Cell Value=" & VluD

If subDict(MapVl - mCount).Exists(VluD) Then
MsgBox "VluD= " & VluD
cResult = subDict(MapVl - mCount).Item(VluD) '<-- Run-time error '450': Wrong number of arguments or invalid property assignment

ArrRslt(x - 1) = cResult
MsgBox "cResult=" & cResult
Else
ArrRslt(x - 1) = "?"
End If
ReDim Preserve ArrRslt(0 To x)
x = x + 1
Next mCount
Next cl
LastRow = WsRslt.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set RngTrgt = WsRslt.Range(Cells(2, Lc + 2), Cells(LastRow, Lc + 2))
RngTrgt = Application.WorksheetFunction.Transpose(ArrRslt)
MsgBox "Mapping Complete!"
End Sub

一旦我能够阅读这些值，我仍然需要弄清楚我将如何解释"；通配符"；MAP中的值。

非常感谢任何指导。