提取了数据之后，怎么把重复项给去掉，请教高手

chj8869

附件中提取数据有重复，怎么样才能把重复的去掉呢，请教老师帮助！！！！

蓝桥玄霜

请见代码。

chj8869

蓝桥玄霜 发表于 2015-11-30 15:09
请见代码。

感谢，老师！！只是现在的这个编码，把重复的去掉了显示为空。怎么改能把空格去掉？

chj8869

各路高手！ 指点指点·······

蓝桥玄霜

并没有设置为空的代码。

chj8869

蓝桥玄霜 发表于 2015-12-2 09:41
并没有设置为空的代码。

可是，代码打进去后，有空的出现，请看下  附件。  

蓝桥玄霜

1. Private Sub 单击提取_Click()
   
2. Dim Ar, i&, d, k, t, ks, js, j&, aa, x$, d1
   
3. [a7:b5000].ClearContents
   
4. Ar = Sheet2.Range("a3").CurrentRegion
   
5. Set d = CreateObject("scripting.dictionary")
   
6. Set d1 = CreateObject("scripting.dictionary")
   
7. ks = [e3].Value: js = [e4].Value: n = 6
   
8. For i = 8 To UBound(Ar)
   
9.    x = Ar(i, 3) & "," & Ar(i, 13)
   
10.    d(x) = d(x) & i & ","
    
11. Next
    
12. k = d.keys
    
13. x = [a3].Value & "," & [c3].Value
    
14. If d.exists(x) Then
    
15.     t = d(x)
    
16.     t = Left(t, Len(t) - 1)
    
17.     If InStr(t, ",") Then
    
18.        aa = Split(t, ",")
    
19.        For j = 0 To UBound(aa)
    
20.            If Ar(aa(j), 8) >= ks And Ar(aa(j), 8) <= js Then
    
21.               For y = 18 To UBound(Ar, 2) Step 12
    
22.                   If Ar(aa(j), y) <> "" Then
    
23.                      If Not d1.exists(Ar(aa(j), y)) Then
    
24.                         n = n + 1
    
25.                          d1(Ar(aa(j), y)) = ""
    
26.                          Cells(n, 1) = Ar(aa(j), y)
    
27.                          Cells(n, 2) = Ar(aa(j), y + 10)
    
28.                     End If
    
29.                 Else
    
30.                     Exit For
    
31.                 End If
    
32.             Next
    
33.         End If
    
34.     Next
    
35. Else
    
36.     If Ar(t, 8) >= ks And Ar(t, 8) <= js Then
    
37.         For y = 18 To UBound(Ar, 2) Step 12
    
38.             If Ar(t, y) <> "" Then
    
39.                 If Not d1.exists(Ar(t, 18)) Then
    
40.                     n = n + 1
    
41.                     d1(Ar(t, 18)) = ""
    
42.                     Cells(n, 1) = Ar(t, 18)
    
43.                     Cells(n, 2) = Ar(t, 28)
    
44.                 Else
    
45.                     Exit For
    
46.                 End If
    
47.             End If
    
48.         Next
    
49.     End If
    
50. End If
    
51. [d6] = n - 6
    
52. End If
    
53. End Sub
    
54. 
    

复制代码

chj8869

蓝桥玄霜 发表于 2015-12-3 16:56

感谢老师，问题已解决，代码消化中。。。。。

LMY123

d(x) = d(x) & i & ","