求助老师关于字典的键和值同时去重

yuason

有A，B两列数据，我用字典只能对A列做键去重，但是B列做值的话，B列还是有重复的，想问下老师，怎样对字典的值也进行去重呢？

lcluck2002

字典的键和值同时去重1121.xlsm

zxsea_7426

ssfx1982

1. Sub a2()
   
2. Dim d, brr(), i&, m&, n&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [A1:B10]
   
5. For i = 1 To UBound(arr)
   
6.     If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
   
7.     d(arr(i, 1))(arr(i, 2)) = ""
   
8. Next
   
9. t = d.keys
   
10. 
    
11. For m = 0 To d.Count - 1
    
12.     a1 = d(t(m)).keys
    
13.     s = ""
    
14.     For n = 0 To UBound(a1)
    
15.         s = s & "," & a1(n)
    
16.     Next n
    
17.         ReDim Preserve brr(1 To m + 1)
    
18.         brr(m + 1) = Mid(s, 2)
    
19. Next m
    
20. [C1].Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.keys)
    
21. [D1].Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(brr)
    
22. 
    
23. Set d = Nothing: Erase brr
    
24. End Sub
    
25. 可以使用两个字典或者是字典嵌套，仅供参考

复制代码

perfect131

不推荐用转置函数，用二维数组，字典记录 数组行号

jz_l

准提部林

Sub a()
Set d = CreateObject("scripting.dictionary")
arr = [A1:B10]
For i = 1 To UBound(arr)
    t1$ = arr(i, 1): t2$ = arr(i, 2): tt$ = t1 & "|" & t2
    r = d(t1):  d(tt) = d(tt) + 1
    If r = 0 Then n = n + 1: d(t1) = n: arr(n, 1) = t1: arr(n, 2) = t2
    If r > 0 And d(tt) = 1 Then arr(r, 2) = arr(r, 2) & "," & t2
Next
[C1:D1].Resize(n) = arr
End Sub

sdytsxd991122

加一个判断，就可以

perfect131

sdytsxd991122 发表于 2022-11-22 13:37
加一个判断，就可以

这样写容易遗漏，CE 里面 包含 E，但 CE ≠ E
最好两边加特定符号

捞屎人

前几天给人写过吧