[已解决]查询去重

爱很简单

求修改，字典查询的结果已经实现，查询的结果去重还未实现，求高手修改，谢谢

最佳答案

月排行榜 / 总排行榜

lisachen

2017-7-1 14:54

增加一个字典

1. Sub 查询()
   
2.     arr = Range("d2:f11")   '数据源
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         x = arr(i, 1)
   
7.         If Not d.exists(x) Then d(x) = ""
   
8.         For j = 2 To UBound(arr, 2)
   
9.             If Not d1.exists(arr(i, j)) Then
   
10.                 d1(arr(i, j)) = ""
    
11.                 If Len(arr(i, j)) Then d(x) = d(x) & "," & arr(i, j)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     ReDim brr(1 To d.Count, 1 To 100)
    
16.     For Each x In d.keys
    
17.         n = n + 1
    
18.         brr(n, 1) = x
    
19.         If InStr(d(x), ",") Then
    
20.             xrr = Split(d(x), ",")
    
21.             For k = 1 To UBound(xrr)
    
22.                 brr(n, k + 1) = xrr(k)
    
23.                 If k + 1 > kmax Then kmax = k + 1
    
24.             Next
    
25.         End If
    
26.     Next
    
27.     [o2].Resize(n, 100) = brr
    
28. End Sub

复制代码

跳转到最佳答案楼层

lisachen

增加一个字典

1. Sub 查询()
   
2.     arr = Range("d2:f11")   '数据源
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         x = arr(i, 1)
   
7.         If Not d.exists(x) Then d(x) = ""
   
8.         For j = 2 To UBound(arr, 2)
   
9.             If Not d1.exists(arr(i, j)) Then
   
10.                 d1(arr(i, j)) = ""
    
11.                 If Len(arr(i, j)) Then d(x) = d(x) & "," & arr(i, j)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     ReDim brr(1 To d.Count, 1 To 100)
    
16.     For Each x In d.keys
    
17.         n = n + 1
    
18.         brr(n, 1) = x
    
19.         If InStr(d(x), ",") Then
    
20.             xrr = Split(d(x), ",")
    
21.             For k = 1 To UBound(xrr)
    
22.                 brr(n, k + 1) = xrr(k)
    
23.                 If k + 1 > kmax Then kmax = k + 1
    
24.             Next
    
25.         End If
    
26.     Next
    
27.     [o2].Resize(n, 100) = brr
    
28. End Sub

复制代码