求助，数据匹配和分类的问题

wangyz0903

求教各位老师，有一张表，需要用系统1数据和系统2数据进行匹配，匹配关键字为“货品代码”，符合条件的记录放入“匹配成功的数据”，“匹配成功的数据”中格式和内容（数量）要求应该和”系统1数据“的格式和内容（数量）一致，如果”系统1数据“中有记录，但是“系统2数据“中无记录，则将该条记录放入“匹配失败的数据1”，如果”系统2数据“中有记录，但是“系统1数据“中无记录，则将该条记录放入“匹配失败的数据2”，谢谢大佬~

3190496160

Sub 数据匹配()
Dim d As Object, dc As Object, dic As Object
Dim ar As Variant, br As Variant
Dim arr1(), arr2(), arr3(), brr()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
ar = Sheets("系统1数据").[a1].CurrentRegion
br = Sheets("系统2数据").[a1].CurrentRegion
ReDim arr1(1 To UBound(ar) + UBound(br), 1 To 3) ''两表均有
ReDim arr2(1 To UBound(ar) + UBound(br), 1 To 3) ''2有1没有
ReDim arr3(1 To UBound(ar) + UBound(br), 1 To 3) ''1有2没有
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = i
    End If
Next i
For i = 2 To UBound(br)
    If Trim(br(i, 1)) <> "" Then
        dc(Trim(br(i, 1))) = i
        If d.Exists(Trim(br(i, 1))) Then
            n_1 = n_1 + 1
            For j = 1 To 3
                arr1(n_1, j) = br(i, j)
            Next j
        ElseIf Not d.Exists(Trim(br(i, 1))) Then
            n_2 = n_2 + 1
            For j = 1 To 3
                arr2(n_2, j) = br(i, j)
            Next j
        End If
    End If
Next i
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        If dc.Exists(Trim(br(i, 1))) Then
            n_1 = n_1 + 1
            For j = 1 To 3
                arr1(n_1, j) = ar(i, j)
            Next j
        ElseIf Not dc.Exists(Trim(br(i, 1))) Then
            n_3 = n_3 + 1
            For j = 1 To 3
                arr3(n_3, j) = ar(i, j)
            Next j
        End If
    End If
Next i
ReDim brr(1 To n_1, 1 To 3)
For i = 1 To n_1
    t = dic(Trim(arr1(i, 1)))
    If t = "" Then
        k = k + 1
        dic(Trim(arr1(i, 1))) = k
        t = k
        For j = 1 To 3
            brr(k, j) = arr1(i, j)
        Next j
    End If
Next i
With Sheets("匹配成功的数据")
    .[a1].CurrentRegion.Offset(1) = Empty
    If n_1 <> "" Then .[a2].Resize(n_1, 3) = brr
End With
With Sheets("匹配失败的数据1")
    .[a1].CurrentRegion.Offset(1) = Empty
    If n_3 <> "" Then .[a2].Resize(n_3, 3) = arr3
End With
With Sheets("匹配失败的数据2")
    .[a1].CurrentRegion.Offset(1) = Empty
    If n_2 <> "" Then .[a2].Resize(n_2, 3) = arr2
End With
MsgBox "ok!"
End Sub

3190496160

数据匹配与分类.zip (18.65 KB, 下载次数: 13)

2020-10-17 10:50 上传

点击文件名下载附件

3190496160

在  系统2数据  中有很多行是重复的，不知道楼主是什么意思，代码仅供参考，