求大佬看看数据对比怎么写

alstar

最初的思路是将两组数据装入两个字典中，对比它们的key值，如果相等在对比他们的item。

写到一半不会写了。求大佬帮帮忙。。谢谢！！!



对比.rar (7.71 KB, 下载次数: 17)

2018-8-11 19:44 上传

点击文件名下载附件

ww87725244

你这是要填充底纹和文字颜色，写入字典干什么？

alstar

ww87725244 发表于 2018-8-11 20:17
你这是要填充底纹和文字颜色，写入字典干什么？

追求速度快啊，大佬 。。用循环做，数据量大了挺慢的。。

jiminyanyan

http://club.excelhome.net/thread-1143188-1-1.html
和这个案例类似吧。。

ww87725244

1. Sub aa()
   
2. Dim i&, d As Object, ar, n&, m&, n1&, m1&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Application.ScreenUpdating = False
   
5. With Sheet1
   
6.     .UsedRange.ClearFormats
   
7.     ar = .UsedRange
   
8.     For i = 2 To UBound(ar)
   
9.         If d.exists(ar(i, 1)) Then
   
10.             m = Split(d(ar(i, 1)), "/")(1)
    
11.             If ar(i, 2) <> Val(Split(Split(d(ar(m, 4)), "/")(0), "-")(1)) Then
    
12.                 .Cells(i, "f").Font.ColorIndex = 3
    
13.                 .Cells(m, "g").Font.ColorIndex = 3
    
14.                 d(ar(i, 1)) = Split(d(ar(i, 1)), "-")(1)
    
15.             End If
    
16.             .Range("g" & m).Resize(1, 2).Interior.ColorIndex = 0
    
17.         Else
    
18.             n = n + 1
    
19.             d(ar(i, 1)) = n & "-" & ar(i, 2) & "/" & i
    
20.             .Range("e" & i).Resize(1, 2).Interior.ColorIndex = 4
    
21.         End If
    
22.         If d.exists(ar(i, 4)) Then
    
23.             m1 = Split(d(ar(i, 4)), "/")(1)
    
24.             If ar(i, 3) <> Val(Split(Split(d(ar(m1, 1)), "/")(0), "-")(1)) Then
    
25.                 .Cells(i, "g").Font.ColorIndex = 3
    
26.                 .Cells(m1, "f").Font.ColorIndex = 3
    
27.                 d(ar(i, 4)) = Split(d(ar(i, 4)), "-")(1)
    
28.             End If
    
29.             .Range("e" & m1).Resize(1, 2).Interior.ColorIndex = 0
    
30.         Else
    
31.             n1 = n1 + 1
    
32.             d(ar(i, 4)) = n1 & "-" & ar(i, 3) & "/" & i
    
33.             .Range("g" & i).Resize(1, 2).Interior.ColorIndex = 4
    
34.         End If
    
35.         n = 0
    
36.         n1 = 0
    
37.     Next
    
38.     .UsedRange.HorizontalAlignment = xlCenter
    
39. End With
    
40. Set d = Nothing
    
41. Application.ScreenUpdating = True
    
42. End Sub

复制代码