查找数据、核对并显示无误

蓝色六百度

求助需求：就是按公司表页里每一行的金额、订单号、银联订单号与数据表里的每一行的三项数据匹配，如果都一样则在结果表里显示“全部匹配”如果有不一样的，则把公司表里不一样的那一行显示到结果表里
主要目的就是核对公司表里的数据是不是都在数据表里，而且三项数据都是对的


非常感谢。

skyzxh

1. Sub 核对()
   
2. Dim i&, r&
   
3. 
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Range("k2:K65536").ClearContents
   
6. With Sheets("数据")
   
7.     r = .Cells(Rows.Count, 5).End(3).Row
   
8.     For i = 1 To r
   
9.         d(.Cells(i, "X").Value & "_" & .Cells(i, "E").Value & "_" & .Cells(i, "F").Value) = ""
   
10.     Next
    
11. End With
    
12. r = Cells(Rows.Count, 9).End(3).Row
    
13. For i = 2 To r
    
14.     If Not d.exists(Cells(i, "H").Value & "_" & Cells(i, "I").Value & "_" & Cells(i, "C").Value) Then
    
15.         Cells(i, "K") = "未匹配"
    
16.     End If
    
17. Next
    
18. End Sub
    

复制代码

skyzxh

。。。。。。。。。。。。。。。。。。。。。

zax010

Sub zz()
    Dim d1, d2, ar, br
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    ar = Sheet2.Range("C2:I" & Sheet2.[h6536].End(3).Row)
    br = Sheet1.UsedRange
    For i = 1 To UBound(ar)
        d1(ar(i, 7)) = ar(i, 1) & "," & ar(i, 6)
    Next
    For i = 2 To UBound(br)
        d2(br(i, 5)) = br(i, 6) & "," & br(i, 24)
    Next
        For Each k In d1.keys
            If d2.exists(k) Then
                Cells(2 + n, 1).Resize(1, 2) = Split(d1(k), ",")
                Cells(2 + n, 3) = k
                If d1(k) = d2(k) Then
                    Cells(2 + n, 4) = "全部匹配"
                Else
                    Cells(2 + n, 4) = "不匹配"
                End If
            End If
            n = n + 1
        Next
End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>>>>>>


核对.rar (159.21 KB, 下载次数: 43)

2016-1-28 21:29 上传

点击文件名下载附件

蓝色六百度

非常感谢楼上各位大师，似乎总是有困难了才来向大家求助，实在是汗颜，以后一定努力学习，争取早日也可以帮助别人。再次感谢

zax010

改进代码，详细核对：

Sub zz()
    Dim d1, d2, ar, br
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    ar = Sheet2.Range("C2:I" & Sheet2.[h6536].End(3).Row)
    br = Sheet1.UsedRange
    For i = 1 To UBound(ar)
        d1(ar(i, 7)) = ar(i, 1) & "," & ar(i, 6)
    Next
    For i = 2 To UBound(br)
        d2(br(i, 5)) = br(i, 6) & "," & br(i, 24)
    Next
    For Each k In d1.keys
        If d2.exists(k) Then
            Cells(2 + n, 1).Resize(1, 2) = Split(d1(k), ",")
            Cells(2 + n, 3) = k
            If d1(k) = d2(k) Then
                Cells(2 + n, 4) = "全部匹配"
            Else
                Cells(2 + n, 4) = "不匹配"
            End If
            Cells(2 + n, 5).Resize(1, 2) = Split(d2(k), ",")
            If Cells(2 + n, 1) <> Cells(2 + n, 5) Then Cells(2 + n, 1).Interior.ColorIndex = 3
            If Cells(2 + n, 2) <> Cells(2 + n, 6) Then Cells(2 + n, 2).Interior.ColorIndex = 3
        End If
        n = n + 1
    Next
End Sub

zax010

各银联订单号对应的不匹配数据标红显示。

核对.rar (159.41 KB, 下载次数: 63)

2016-1-29 10:09 上传

点击文件名下载附件

蓝色六百度

继续请教，如果说我两个表格的列有变动的话，是不是改   
For i = 1 To UBound(ar)
        d1(ar(i, 7)) = ar(i, 1) & "," & ar(i, 6)
    Next
    For i = 2 To UBound(br)
        d2(br(i, 5)) = br(i, 6) & "," & br(i, 24)这几句就可以了呢，可是为什么好像改完不行，

蓝色六百度

zax010 发表于 2016-1-29 10:09
各银联订单号对应的不匹配数据标红显示。

谢谢，好厉害。