[已解决]用VBA求一列数显示多个不重数值

xhuang

HI，all

以下列有多个重复数，有没有公式可以自动统出来，

VBA结果要求为：200077，200114，200157，200197，200216 （需要用豆号区分，显示为一个值，先谢了）

我主要是复制导入到系统里面去做数据运算的。系统支持多个查询，并且需要豆号区分即可，请帮忙！

列的数据有点多，多的时候有20000条，详细如附件！

最佳答案

月排行榜 / 总排行榜

云影

2014-7-8 17:45

1. Sub test()
   
2.     Dim arr, x%, Str$, d As Object
   
3.     arr = Range("a1").CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.         For x = 2 To UBound(arr)
   
6.             If Not d.exists(arr(x, 1)) Then
   
7.                 Str = Str & "," & arr(x, 1)
   
8.             End If
   
9.                 d(arr(x, 1)) = ""
   
10.         Next
    
11.         Range("D4") = "'" & Mid(Str, 2)
    
12. End Sub
    

复制代码

或

1. Sub test()
   
2.     Dim arr, x&, Str$, d As Object, rng As Range
   
3.     arr = Application.InputBox("请选择数据源", "提示", , , , , , 8)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For x = 2 To UBound(arr)
   
6.         If Not d.exists(arr(x, 1)) Then
   
7.             Str = Str & "," & arr(x, 1)
   
8.         End If
   
9.         d(arr(x, 1)) = ""
   
10.     Next
    
11.     Set rng = Application.InputBox("请选择存放地址", "提示", , , , , , 8)
    
12.     rng = "'" & Mid(Str, 2)
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

xhuang

增加附件！

云影

1. Sub test()
   
2.     Dim arr, x%, Str$, d As Object
   
3.     arr = Range("a1").CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.         For x = 2 To UBound(arr)
   
6.             If Not d.exists(arr(x, 1)) Then
   
7.                 Str = Str & "," & arr(x, 1)
   
8.             End If
   
9.                 d(arr(x, 1)) = ""
   
10.         Next
    
11.         Range("D4") = "'" & Mid(Str, 2)
    
12. End Sub
    

复制代码

或

1. Sub test()
   
2.     Dim arr, x&, Str$, d As Object, rng As Range
   
3.     arr = Application.InputBox("请选择数据源", "提示", , , , , , 8)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For x = 2 To UBound(arr)
   
6.         If Not d.exists(arr(x, 1)) Then
   
7.             Str = Str & "," & arr(x, 1)
   
8.         End If
   
9.         d(arr(x, 1)) = ""
   
10.     Next
    
11.     Set rng = Application.InputBox("请选择存放地址", "提示", , , , , , 8)
    
12.     rng = "'" & Mid(Str, 2)
    
13. End Sub
    

复制代码

张雄友

3楼代码是不重复哦，楼主是要重复还是不重复？

xhuang

张雄友 发表于 2014-7-8 18:55
3楼代码是不重复哦，楼主是要重复还是不重复？

不重复，谢谢各位的帮助，谢谢！