我想知道是否有人可以帮助我找出如何以特定格式匹配两张纸上的数据。我需要匹配的数据中的Here is an example，包括显示预期输出的示例。
请注意，UniqueToGroup_ID仅对列出的特定Group_ID唯一。如您所见，我列出的两个示例Group_ID都包含XSTN的UniqueToGroup_ID值，该值将返回两个不同的结果ID。 Group_ID 16453为2306765，Group_ID 8156705为8277773。
通过组合文本到列，将Group_ID添加到UniqueToGroup_ID和NotUniqueToGroup_ID以及VLOOKUP中，我可以（痛苦地）半手动地执行此操作，但这需要花很多时间，而且我经常需要这样做。
我还没有尝试编写任何VBA，因为我不确定如何解决此问题。我没有编码方面的经验。
请参见示例here（Dropbox）
谢谢您的任何建议。
答案 0 :(得分：1)
您可以使用字典构建两列交叉引用。
Option Explicit
Sub ertgyhj()
Dim i As Long, ii As String, gi As Long, ugi As String, nuid As Long, r As String
Dim a As Long, itm As String, tmp As String, arr As Variant, xref As Object, results As Object
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = Worksheets("original data")
Set ws2 = Worksheets("data to match")
Set ws3 = Worksheets("sample result")
Set xref = CreateObject("scripting.dictionary")
Set results = CreateObject("scripting.dictionary")
'build two column cross reference dictionary
With ws2
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
itm = Join(Array(.Cells(i, "A").Value2, .Cells(i, "B").Value2), Chr(124))
xref.Item(itm) = .Cells(i, "C").Value2
Next i
End With
'put column header labels into results
results.Item("image_id") = "result"
'collect results
With ws1
'loop through rows
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
ii = .Cells(i, "A").Value2
gi = .Cells(i, "B").Value2
ugi = .Cells(i, "C").Value2
tmp = vbNullString
arr = Split(ugi, Chr(124))
'loop through UniqueToGroup_ID and find matches
For a = LBound(arr) To UBound(arr)
itm = Join(Array(gi, arr(a)), Chr(124))
If xref.exists(itm) Then
tmp = IIf(CBool(Len(tmp)), tmp & Chr(124), vbNullString) & xref.Item(itm)
End If
Next a
'store concatenated result with image id
results.Item(ii) = tmp
Next i
End With
'post results
With ws3
.Cells(1, "A").Resize(results.Count, 1) = Application.Transpose(results.keys)
.Cells(1, "B").Resize(results.Count, 1) = Application.Transpose(results.items)
End With
End Sub
答案 1 :(得分：1)
Workbook Download how-to-match-up-data-from-two-spreadsheets-using-specific-format_54299649.xls
Sub CrazyLookup()
Const cSheet1 As String = "Original Data" ' 1st Source Worksheet Name
Const cSheet2 As String = "Data To Match" ' 2nd Source Worksheet Name
Const cSheet3 As String = "Sample Result" ' Target Worksheet Name
Const cFirstR As Long = 2 ' First Row Number
Const cFirstC As Variant = "A" ' First Column Letter/Number
Const cLastC As Variant = "C" ' Source Worksheet's Last Column
Const cNoC As Long = 2 ' Number of Columns of Target Array/Range
Const cDel As String = "|" ' Split/Join Delimiter
Dim vnt1 As Variant ' 1st Source Array
Dim vnt2 As Variant ' 2nd Source Array
Dim vnt3 As Variant ' Target Array
Dim vntU As Variant ' Unique Array
Dim lastR1 As Long ' Last Row Number of 1st Source Range
Dim lastR2 As Long ' Last Row Number of 2nd Source Range
Dim i As Long ' 1st Source Array Row Counter
Dim j As Long ' Unique Array Row Counter
Dim k As Long ' 2nd Source Array Row Counter
Application.ScreenUpdating = False
On Error GoTo ProcedureExit
' Write 1st Source Range to 1st Source Array.
With ThisWorkbook.Worksheets(cSheet1)
lastR1 = .Columns(.Cells(1, cFirstC).Column) _
.Find("*", , -4123, , 2, 2).Row
vnt1 = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR1, cLastC))
End With
' Write 2nd Source Range to 2nd Source Array.
With ThisWorkbook.Worksheets(cSheet2)
lastR2 = .Columns(.Cells(1, cFirstC).Column) _
.Find("*", , -4123, , 2, 2).Row
vnt2 = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR2, cLastC))
End With
' Resize Target Array TO 1st Source Array's rows count and TO
' Number of Columns of Target Array.
ReDim vnt3(1 To UBound(vnt1), 1 To cNoC)
' Write First Source Array's First Column to Target Array's first column.
For i = 1 To UBound(vnt1)
vnt3(i, 1) = vnt1(i, 1)
Next
' Write
For i = 1 To UBound(vnt1) ' Loop through rows of 1st Source Array.
' Split 1st Source Array's row in 3rd column to Unique Array.
vntU = Split(vnt1(i, 3), cDel)
For j = 0 To UBound(vntU) ' Loop through rows of Unique Array.
For k = 1 To UBound(vnt2) ' Loop through rows of 2nd Source Array.
' Match 1st Source Array's row in 2nd column TO 2nd Source
' Array's row in first column AND Unique Array's row TO
' 2nd Source Array's row in 2nd column.
If vnt1(i, 2) = vnt2(k, 1) And vntU(j) = vnt2(k, 2) Then
' Write from 2nd Source Array's row in 3rd column to
' Unique Array's row.
vntU(j) = vnt2(k, 3)
Exit For ' Stop searching.
End If
Next
' Check if match was not found.
If k > UBound(vnt2) Then vntU(j) = "NotFound"
Next
' Join Unique Array's rows to Target Array's row in second column.
vnt3(i, 2) = Join(vntU, cDel)
Next
With ThisWorkbook.Worksheets(cSheet3)
' Clear contents of Target Range columns (excl. Headers).
.Range(.Cells(cFirstR, cFirstC), .Cells(.Rows.Count, _
.Cells(1, cFirstC).Column + cNoC - 1)).ClearContents
' Copy Target Array to Target Range.
.Cells(cFirstR, cFirstC).Resize(UBound(vnt3), UBound(vnt3, 2)) = vnt3
End With
ProcedureExit:
Application.ScreenUpdating = True
End Sub
答案 2 :(得分：1)
我建立了一个工作簿，我认为它可以解决您的问题。让我知道是否有帮助！
https://www.dropbox.com/s/3h6mja0xtwucbr5/20180121-Matching.xlsm?dl=0