多行数据从小到大排列，去重复。

bkhnsz

有多行数据，需要从小到大排序，去掉重复的。用逗号分隔，放置H1单元格。谢谢。
多行数据排序问题.rar (5.94 KB, 下载次数: 12)

2017-8-3 11:10 上传

点击文件名下载附件
数据排序

chxw68

字典法：

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet2")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a1:e" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       For j = 1 To UBound(arr)
    
11.         d(arr(i, j)) = ""
    
12.       Next
    
13.     Next
    
14.     brr = d.keys
    
15.     For i = 0 To UBound(brr) - 1
    
16.       p = i
    
17.       For j = i + 1 To UBound(brr)
    
18.         If brr(p) > brr(j) Then
    
19.           p = j
    
20.         End If
    
21.       Next
    
22.       If p <> i Then
    
23.         temp = brr(i)
    
24.         brr(i) = brr(p)
    
25.         brr(p) = temp
    
26.       End If
    
27.     Next
    
28.     .Range("h1") = Join(brr, ",")
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

详见附件。

chxw68

如果楼主排序的数据都是整数的话，也可以使用数组实现。

1. Sub test2() '数组法
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet2")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a1:e" & r)
   
9.     mm = Application.Max(arr)
   
10.     nn = Application.Min(arr)
    
11.     ReDim brr(nn To mm)
    
12.     For i = 1 To UBound(arr)
    
13.       For j = 1 To UBound(arr)
    
14.         brr(arr(i, j)) = 1
    
15.       Next
    
16.     Next
    
17.     ss = ""
    
18.     For i = nn To mm
    
19.       If brr(i) = 1 Then
    
20.         ss = ss & "," & i
    
21.       End If
    
22.     Next
    
23.     .Range("h1") = Mid(ss, 2)
    
24.   End With
    
25. End Sub
    

复制代码

chxw68

增加了数组排序法。

bkhnsz

谢谢chxw68，如果排序结果放在任意指定的某单元格，比如H2或R5等等，该怎样改进代码?

chxw68

bkhnsz 发表于 2017-8-3 17:16
谢谢chxw68，如果排序结果放在任意指定的某单元格，比如H2或R5等等，该怎样改进代码?

修改下面这句：  
.Range("h1") = Mid(ss, 2)

bkhnsz

chxw68 发表于 2017-8-3 17:18
修改下面这句：  
.Range("h1") = Mid(ss, 2)

谢谢，可否用一个按钮指定输入放在某单元格?

chxw68

bkhnsz 发表于 2017-8-3 17:31
谢谢，可否用一个按钮指定输入放在某单元格?

用按钮怎么指定呢？

bkhnsz

chxw68 发表于 2017-8-3 17:52
用按钮怎么指定呢？

可以用一个按钮，谢谢