两个不同工作表数据对比 谢谢

li446425169

按照日期工作表对比
1.本工作簿只会有3个工作表（首页、日期1、日期2）


    第一个工作表始终是首页，第二个工作表日期肯定在前，第二个工作表日期会是第一个工作表日期的后一天
    工作表对比的数据最多500行
2.对比2个日期工作表里面数据变化
   对比需求（靠前日期里标记紫色为整行取消或者数量变动，靠后日期里标记黄色为整行增加或者数量变动，）
    a.靠后日期的工作表里面数据如果一整行都没有在靠前日期工作表里出现，那将此行单元格底色标记为黄色
       如果靠后日期工作表里面A列-D列都在靠前工作表里面出现（A列-D列必须全部相同），只是E列数量和靠前工作表里的数量不同，则只需要标记数量单元格为黄色
       标记整行都是黄色说明是此行数据全部是新增，标记数量为黄色说明只是此行数量变动。
       标记黄色只出现在靠后日期工作表（黄色代表新增或者数量变动）

    b.靠前日期的工作表里面数据如果一整行都没有在靠后日期工作表里出现，那将此行单元格底色标记为紫色
       如果靠前日期工作表里面A列-D列都在靠后工作表里面出现（A列-D列必须全部相同），只是E列数量和靠后工作表里的数量不同，则只需要标记数量单元格为紫色
       标记整行都是紫色说明此行数据相对于后一个工作表是取消，标记数量为紫色说明只是此行数量变动
       标记紫色只出现在靠前日期工作表（紫色代表取消或者数量变动）


哪位老师有空请帮助，谢谢

fzxba

1. Sub test1()
   
2.   Dim vData(2 To 3), Dict(2 To 3) As Object
   
3.   Dim i As Long, j As Long, k As Integer
   
4.   Dim nColor As Long, strKey As String
   
5.   
   
6.   For k = LBound(vData) To UBound(vData)
   
7.     Set Dict(k) = CreateObject("Scripting.Dictionary")
   
8.     With Worksheets(k).Range("A1").CurrentRegion
   
9.       .Interior.Color = xlNone
   
10.       vData(k) = .Value
    
11.     End With
    
12.     For i = 2 To UBound(vData(k))
    
13.       strKey = vbNullString
    
14.       For j = 1 To 4
    
15.         strKey = strKey & "|" & vData(k)(i, j)
    
16.       Next
    
17.       Dict(k).Add strKey, vData(k)(i, j)
    
18.     Next
    
19.   Next
    
20.   
    
21.   For k = LBound(Dict) To UBound(Dict)
    
22.     nColor = Array(14336204, 65535)(-(k = 3))
    
23.     For i = 2 To UBound(vData(k))
    
24.       strKey = vbNullString
    
25.       For j = 1 To 4
    
26.         strKey = strKey & "|" & vData(k)(i, j)
    
27.       Next
    
28.       With Worksheets(k)
    
29.         If Dict(5 - k).Exists(strKey) Then
    
30.           If vData(k)(i, 5) <> Dict(5 - k)(strKey) Then
    
31.             .Cells(i, 5).Interior.Color = nColor
    
32.           End If
    
33.         Else
    
34.           .Cells(i, 1).Resize(, UBound(vData(k), 2)).Interior.Color = nColor
    
35.         End If
    
36.       End With
    
37.     Next
    
38.     Set Dict(5 - k) = Nothing
    
39.   Next
    
40.   
    
41.   Beep
    
42. End Sub

复制代码

fzxba

不同工作表数据对比.rar (35.24 KB, 下载次数: 30)

2022-12-18 12:24 上传

点击文件名下载附件

li446425169

fzxba 发表于 2022-12-18 12:24

太感谢了，谢谢

准提部林

與樓上一樣方法//
Xl0000328.rar (26.25 KB, 下载次数: 15)

2022-12-18 14:18 上传

点击文件名下载附件

chsconan

这个挺好的  我觉可以继续提升