数据对比求差异

38180203

WPS
两列数据对比。。每组数据为2列组成  
对比的有纯数字。有字母，纯中文组成  因为涉及到有很多重复的一模一样的我们要的是： A组独有  B组独有  AB共同有这三组加起来的条数等于前面AB总条数  差异的标记红色
谢谢

limonet

关键字：join type

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;Hdr=No';Data Source=" & ThisWorkbook.FullName
    StrSQL1 = "Select a.* From [Sheet1$A2:B]a Left Join [Sheet1$D2:E]b On a.F1&a.F2=b.F1&b.F2 Where b.F1&b.F2 is Null"
    StrSQL2 = "Select b.* From [Sheet1$A2:B]a Right Join [Sheet1$D2:E]b On a.F1&a.F2=b.F1&b.F2 Where a.F1&a.F2 is Null"
    StrSQL3 = "Select b.* From [Sheet1$A2:B]a Inner Join [Sheet1$D2:E]b On a.F1&a.F2=b.F1&b.F2"
    Range("G2").CopyFromRecordset Cn.Execute(StrSQL1)
    Range("J2").CopyFromRecordset Cn.Execute(StrSQL2)
    Range("M2").CopyFromRecordset Cn.Execute(StrSQL3)
End Sub

cidanji

38180203

limonet 发表于 2024-5-9 09:43
关键字：join type

老师您好。

gwjkkkkk

Option Explicit
Sub TEST9()
    Dim ar, br, i&, j&, r&, dic(1 To 2) As New Dictionary, vKey, iPosCol&
   
    Application.ScreenUpdating = False
    ReDim ar(1 To 2)
    For i = 1 To 2
        ar(i) = Cells(1, (i - 1) * 3 + 1).CurrentRegion.Value
        For j = 2 To UBound(ar(i))
            dic(i)(ar(i)(j, 1) & "," & ar(i)(j, 2)) = Empty
        Next j
    Next i
   
    ReDim br(1 To UBound(ar(1)) + UBound(ar(2)), 1 To 3)
    ReDim ar(1 To 3)
    For i = 1 To UBound(ar)
        ar(i) = br
    Next i
   
   
    For Each vKey In dic(2).Keys
        If dic(1).Exists(vKey) Then
            ar(3)(1, 3) = ar(3)(1, 3) + 1
            ar(3)(ar(3)(1, 3), 1) = Split(vKey, ",")(0)
            ar(3)(ar(3)(1, 3), 2) = Split(vKey, ",")(1)
        Else
            ar(2)(1, 3) = ar(2)(1, 3) + 1
            ar(2)(ar(2)(1, 3), 1) = Split(vKey, ",")(0)
            ar(2)(ar(2)(1, 3), 2) = Split(vKey, ",")(1)
        End If
    Next
        For Each vKey In dic(1).Keys
        If Not dic(2).Exists(vKey) Then
            ar(1)(1, 3) = ar(1)(1, 3) + 1
            ar(1)(ar(1)(1, 3), 1) = Split(vKey, ",")(0)
            ar(1)(ar(1)(1, 3), 2) = Split(vKey, ",")(1)
        End If
    Next
    For j = 1 To UBound(ar)
        iPosCol = (j - 1) * 3 + 7
        Cells(1, iPosCol).CurrentRegion.Offset(1).ClearContents
        Cells(2, iPosCol).Resize(ar(j)(1, 3), 2) = ar(j)
    Next j
   
    Erase dic
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

38180203

cidanji 发表于 2024-5-9 10:37

您好老师可能我没说明白，，

limonet

38180203 发表于 2024-5-9 10:39
老师您好。

WPS要装aCCESS库。

38180203

gwjkkkkk 发表于 2024-5-9 10:40
请参考。。。

老师您好，，涉及到有很多重复的一模一样的。我们要的是： A组独有  B组独有  AB共同有这三组加起来的条数等于前面AB总条数