运用字典条目标记实现两列数据对比

sxo

1. Sub sdyt()
   
2.    Set d = CreateObject("scripting.dictionary")
   
3.    arr = ActiveSheet.Range("a2").CurrentRegion
   
4.    For i = 3 To UBound(arr)
   
5.    s = arr(i, 2) & "|" & arr(i, 3)
   
6.    d(s) = "原表"
   
7.    Next
   
8.    brr = ActiveSheet.Range("e2").CurrentRegion
   
9.    For i = 3 To UBound(brr)
   
10.    s1 = brr(i, 2) & "|" & brr(i, 3) '问题要自动加入字典，不经判断
    
11.    If Not d.Exists(s1) Then '判断失效导致字典条目标记错误
    
12.    d(s1) = "新表"
    
13.    Else
    
14.    d(s) = "共有"
    
15.    End If
    
16.    Next
    
17.    i = 3: n = 3: m = 3
    
18.    For Each k In d.Keys
    
19.    If d(k) = "原表" Then
    
20.    ActiveSheet.Cells(i, "j").Resize(, 2) = Split(k, "|")
    
21.    i = i + 1
    
22.    ElseIf d(k) = "新表" Then
    
23.    ActiveSheet.Cells(n, "n").Resize(, 2) = Split(k, "|")
    
24.    n = n + 1
    
25.    ElseIf d(k) = "共有" Then
    
26.    ActiveSheet.Cells(n, "q").Resize(, 2) = Split(k, "|")
    
27.    n = n + 1
    
28.    End If
    
29.    Next
    
30.    Set d = Nothing
    
31. End Sub
    

复制代码

判断两列数据，用字典的条目标记，过程中出现判断错误。

shiruiqiang

通过brr，没有的话追加字典keys，有的话改变字典item（共有）。没验证，不知是否正确

zlzz1971

请用WPS运行

taller

aman1516

两列对比，论坛上太多示例了，所以要先加深对代码的了解，才能灵活变通各种拓展应用，如：
在原数据上标识颜色；
两列是不同工作表的数据源；
只提取（A有B无，B有A无，AB都有等）其中某一项；
输出到不同工作表......
不妨先参考下学习下这个：
【原创】AB列数据对比找差异、相同工具
https://club.excelhome.net/thread-1473172-1-1.html

sxo

taller 发表于 2023-1-7 03:28

为什么逐步执行后“原表无新表有”的列内就没有数据显示，且“原表无新表有”的数据全部追加到了“两表都有的”数据后.
但是直接执行后就正确了？请版主指教。

taller

sxo 发表于 2023-1-9 17:15
为什么逐步执行后“原表无新表有”的列内就没有数据显示，且“原表无新表有”的数据全部追加到了“两表都 ...

不知道你在问啥

sdytsxd991122

sxo 发表于 2023-1-9 17:15
为什么逐步执行后“原表无新表有”的列内就没有数据显示，且“原表无新表有”的数据全部追加到了“两表都 ...

你代码没有理解，好多地方的代码抄错了

sdytsxd991122

sxo 发表于 2023-1-9 17:15
为什么逐步执行后“原表无新表有”的列内就没有数据显示，且“原表无新表有”的数据全部追加到了“两表都 ...

Sub sdyt()
    Set d = CreateObject("scripting.dictionary")
    arr = ActiveSheet.Range("a2").CurrentRegion
    For i = 3 To UBound(arr)
        s = arr(i, 2) & "|" & arr(i, 3)
        d(s) = "原表"
    Next
    brr = ActiveSheet.Range("e2").CurrentRegion
    For i = 3 To UBound(brr)
        s1 = brr(i, 2) & "|" & brr(i, 3)
        If Not d.Exists(s1) Then
            d(s1) = "新表"
        Else
            If d(s1) = "原表" Then
                d(s1) = "共有"
            End If
        End If
    Next
    i = 3: n = 3: m = 3
    For Each k In d.Keys
        If d(k) = "原表" Then
            ActiveSheet.Cells(i, "j").Resize(, 2) = Split(k, "|")
            i = i + 1
        ElseIf d(k) = "新表" Then
            ActiveSheet.Cells(n, "n").Resize(, 2) = Split(k, "|")
            n = n + 1
        ElseIf d(k) = "共有" Then
            ActiveSheet.Cells(m, "q").Resize(, 2) = Split(k, "|")
            m = m + 1
        End If
    Next
    Set d = Nothing
End Sub

sxo

taller 发表于 2023-1-10 00:02
不知道你在问啥

具体问题在附件里。