如何用字典实现多件件的数据差异比对

sunnyliner2018

各位大侠：

   晚上好，我遇到一个比较比较难以解决的案例，我自己已经想了好几天，由于水平有限，一直没有想出如何用字典正确实现。
请各位大神帮我看看。

要求：E列的【物料凭证】是同一个凭证下，先判断T列的【库存地所属厂区】是否一致,如果一致，则不处理，如果不一致，再判断R列【工厂】与T列的【库存地所属厂区】是否一致，不一致时，在U列显示“不一致”
举列：E列的【物料凭证】4909468500，T列的【库存地所属厂区】单元格T2中一个是B公司，另一个单元格T3中是A公司，对比不致，那么拿单元格T2中一个是B公司与单元格R2中的A公司对比，不一致，则在W列返回”不一致“；拿单元格T3中A公司与单元格R3中的A公司对比，一致，则不必处理;

chxw68

1. Sub test()
   
2.     Dim r%, i%, m%
   
3.     Dim arr, brr, zrr()
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("sheet1")
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         .Range("u2:u" & r).ClearContents
   
9.         arr = .Range("a2:u" & r)
   
10.         xm = Empty
    
11.         For i = 1 To UBound(arr)
    
12.             If arr(i, 5) <> xm Then
    
13.                 m = m + 1
    
14.                 ReDim Preserve zrr(1 To m)
    
15.                 zrr(m) = Array(i, i)
    
16.             Else
    
17.                 If m > 0 Then
    
18.                     zrr(m)(1) = i
    
19.                 End If
    
20.             End If
    
21.             xm = arr(i, 5)
    
22.         Next
    
23.         For k = 1 To UBound(zrr)
    
24.             If zrr(k)(1) - zrr(k)(0) > 0 Then
    
25.                 For i = zrr(k)(0) + 1 To zrr(k)(1)
    
26.                     If arr(i, 20) <> arr(zrr(k)(0), 20) Then
    
27.                         For j = zrr(k)(0) To zrr(k)(1)
    
28.                             If arr(j, 18) <> arr(j, 20) Then
    
29.                                 arr(j, 21) = "不一致"
    
30.                             End If
    
31.                         Next
    
32.                         Exit For
    
33.                     End If
    
34.                 Next
    
35.             End If
    
36.         Next
    
37.         .Range("a2:u" & r) = arr
    
38.     End With
    
39. End Sub
    

复制代码

zxsea_7426

chxw68

详见附件。

sunnyliner2018

chxw68 发表于 2022-12-10 20:55

老师：
   感谢您的帮助，真是解决了我多日的困挠，有一点，我不太明白，请帮忙指教：
            If zrr(k)(1) - zrr(k)(0) > 0 Then
                For i = zrr(k)(0) + 1 To zrr(k)(1)
这里的（1）-（0）判断相减大于0，是为了判断是否存在重复凭证号的情形是吗。
For i = zrr(k)(0) + 1 To zrr(k)(1)这种用法，还属于第一次看到，不太明的。

Hontyu

不明白就先评分送花,老师们才乐于解答

sunnyliner2018

zxsea_7426 发表于 2022-12-10 20:55

老师：
  晚上好！
感谢您，之前我写的就是这个方法，然后，怎么都算不出来 ，看了您的代码，才知道，我漏了一个    If d(ar(i, 5)).Count > 1 Then，非常感谢您！
我把这个代码贴出来，希望也能帮到有同样需求的朋友。
Sub text()
Set d = CreateObject("scripting.dictionary")
With Sheet1
    ar = .[a1].CurrentRegion
    For i = 2 To UBound(ar)
        If Not d.exists(ar(i, 5)) Then
        Set d(ar(i, 5)) = CreateObject("scripting.dictionary")
    End If
    d(ar(i, 5))(ar(i, 20)) = ar(i, 5)
    Next i
    For i = 2 To UBound(ar)
        If d(ar(i, 5)).Count > 1 Then
        If ar(i, 18) <> ar(i, 20) Then ar(i, 21) = "不一致"
    End If
    Next i
   .[u1].Resize(UBound(ar), 1) = Application.WorksheetFunction.Index(ar, 0, 21)
End With



End Sub

sunnyliner2018

Hontyu 发表于 2022-12-10 21:53
不明白就先评分送花,老师们才乐于解答

这个送花，必须得有。

sunnyliner2018

zxsea_7426 发表于 2022-12-10 20:55

老师，如是凭证是不重复的只有一个，比如这张4909469461，R列与T列的公司名称不一致，我也想让它显示“不一致”时，我该如何修改

lxdexcel

电脑还能这么用