字典比对数据

rookie2021

求大神给一段代码，可以快速检查当D列和A列公司名称相同时，E列和B列对应的数据是否相同，如果数据不同E列对应数据填充为红色，如果D列有某一个公司名称与A列的不相同则公司名称和对应数据都填充为红色

quqiyuan

你数据不是左右一一对应的，这句话怎么理解：如果D列有某一个公司名称与A列的不相同则公司名称和对应数据都填充为红色

小凡、、、

调用match函数循环判断，思路简单，但效率可能不如字典

ynzsvt

左边的本身有没有重复，右边的本身有没有重复

ykcbf1100

参与一下。注意：数值相差值>0.01的才算不同。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.27
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Range("a1").CurrentRegion
   
6.     Cells.Interior.ColorIndex = 0
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 1)
   
9.         d(s) = arr(i, 2)
   
10.     Next
    
11.     r = Cells(Rows.Count, 4).End(3).Row
    
12.     For i = 2 To r
    
13.         s = Cells(i, 4)
    
14.         If d.exists(s) Then
    
15.             If Abs(Cells(i, 5) - d(s)) > 0.01 Then
    
16.                 Cells(i, 4).Resize(, 2).Cells.Interior.ColorIndex = 3
    
17.             End If
    
18.         Else
    
19.             Cells(i, 4).Resize(, 2).Cells.Interior.ColorIndex = 3
    
20.         End If
    
21.     Next
    
22.     Set d = Nothing
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

sdytsxd991122

quqiyuan

参与一下，供参考。。。

quqiyuan

代码如下。。。

Sub test1()
    brr = Sheet1.[d1].CurrentRegion
    Sheet1.[d1].CurrentRegion.Interior.ColorIndex = 0
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If Not d.exists(arr(i, 1)) Then d(arr(i, 1)) = i
    Next
    For i = 2 To UBound(brr)
        If d.exists(brr(i, 1)) Then
            If brr(i, 2) <> arr(d(brr(i, 1)), 2) Then Sheet1.Cells(i, 5).Interior.Color = vbRed
        Else
            Sheet1.Cells(i, 4).Resize(, 2).Interior.Color = vbRed
        End If
    Next
    Set d = Nothing
    Beep
End Sub

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   d(arr(i, 1)) = arr(i, 2)
Next
brr = [d1].CurrentRegion
For i = 2 To UBound(brr)
   If Not d.exists(brr(i, 1)) Then
      Cells(i, "d").Interior.Color = vbRed
      Cells(i, "e").Interior.Color = vbRed
   ElseIf brr(i, 2) <> d(brr(i, 1)) Then
      Cells(i, "e").Interior.Color = vbRed
   End If
Next
End Sub