[已解决]请高手相助，排列数据并删重

老九别走

       某一个单元格中，有文本型三位数字若干个，每数字间用空格分隔。
       请教：
       如何用VBA使单元格中的每组的三个数字，按照小中大顺序排列，并且删除重复的数字，仍然按照原格式排列在一个单元格内。点击按钮实现。
    详情请参考附件。

新建 Microsoft Excel 工作表.rar (3.7 KB, 下载次数: 35) 2012-7-11 21:47 上传 点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

oobird

2012-7-14 15:33

看起来没这么复杂吧

1. Sub test()
   
2.     Dim s(), arr, d As Object, i%
   
3.     arr = Split(Trim(Range("H2")), " ")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     For i = 0 To UBound(arr)
   
6.         s = Array(Val(Mid(arr(i), 1, 1)), Val(Mid(arr(i), 2, 1)), Val(Mid(arr(i), 3, 1)))
   
7.         x = Application.Small(s, 1) & Application.Small(s, 2) & Application.Small(s, 3)
   
8.         d(x) = ""
   
9.     Next
   
10.     Range("H3") = Join(d.keys)
    
11. End Sub
    

复制代码

跳转到最佳答案楼层

dongqing1998

1. 
   
2. 
   
3. Sub test()
   
4.     Dim reg, s$, arr, a, d, i%, j%, stmp$, atmp
   
5.     Set reg = CreateObject("vbscript.regexp")
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     s = Range("h2")
   
8.     With reg
   
9.         .Global = True
   
10.         .Pattern = "\d{3}"
    
11.         Set arr = .Execute(s)
    
12.     End With
    
13.     For Each a In arr
    
14.         stmp = ""
    
15.         For i = 0 To 9
    
16.             For j = 1 To 3
    
17.                 If InStr(Mid(a, j, 1), i) Then stmp = stmp & i
    
18.             Next
    
19.         Next
    
20.         d(stmp) = ""
    
21.     Next
    
22.     atmp = d.keys
    
23.     stmp = ""
    
24.     For i = 0 To UBound(atmp)
    
25.         stmp = stmp & " " & atmp(i)
    
26.     Next
    
27.     stmp = Mid(stmp, 2)
    
28.     Range("h3") = stmp
    
29. End Sub
    

复制代码

那么的帅

1. 
   
2. Sub TEST()
   
3.     Dim S1 As String, D, I, M, P, Q, T
   
4.     Dim Arr1, Arr2(), S(1 To 3)
   
5.     S1 = Range("H2")
   
6.     Arr1 = Split(S1, " ")
   
7.     Set D = CreateObject("Scripting.Dictionary")
   
8.     For I = 0 To UBound(Arr1)
   
9.         S(1) = Val(Mid(Arr1(I), 1, 1))
   
10.         S(2) = Val(Mid(Arr1(I), 2, 1))
    
11.         S(3) = Val(Mid(Arr1(I), 3, 1))
    
12.         For P = 1 To 2
    
13.             For Q = P + 1 To 3
    
14.                 If S(P) > S(Q) Then
    
15.                     T = S(P)
    
16.                     S(P) = S(Q)
    
17.                     S(Q) = T
    
18.                 End If
    
19.             Next Q
    
20.         Next P
    
21.         S2 = S(1) & S(2) & S(3)
    
22.   '        Stop
    
23.         
    
24.         If Not D.Exists(S2) Then
    
25.             M = M + 1
    
26.             D(S2) = M - 1
    
27.             ReDim Preserve Arr2(0 To M - 1)
    
28.             Arr2(M - 1) = S2
    
29.         End If
    
30.     Next I
    
31.     S3 = Join(Arr2, " ")
    
32.     Range("H3") = S3
    
33. End Sub
    

复制代码

提取不重复字符并组合（VBA）.rar (11.8 KB, 下载次数: 20)

2012-7-11 22:35 上传

点击文件名下载附件

老九别走

经反复验证，【那么的帅】老师的代码经运行后，结果多出一组数字 000 。还请老师再出手修改代码。
费心了，预谢！！！

老九别走

下载后试用，两位老师的大作都非常理想，虽然代码还不能理解，有待今后学习。
深深感谢了！！！

老九别走

那么的帅 发表于 2012-7-14 11:05
H2 单元格里第一个就是000，H3结果里只有1组000，你说的 多出1组000，不知道是怎么回事？

那么的帅 老师：
      你的代码在我所举具体例子中是正确的！！！
      但是，当H2单元格中的数据发生改变时，每次数据转换后，总在数字的最后显示一组 000 。
      请再加以验证！！！
      再次感谢您的出手相帮！！！

现在我改换了一组数据。
H1中的数据为：
009 013 023 025 028 029 049 069 089 096 098 099 103 104 106 108 118 124 126 128 134 142 143 146 147 149 159 160 167 168 169 174 175 176 178 179 180 186 188 189 194 196 197 198 199 204 205 206 207 208 209 214 216 223 227 240 241 247 249 258 260 261 267 268 269 276 277 280 283 284 285 286 287 288 289 290 293 296 298 299 304 306 308 309 314 316 322 328 336 340 346 348 349 358 360 364 366 368 369 378 384 386 387 388 389 390 392 396 398 401 402 403 405 409 412 413 417 421 423 427 429 431 447 449 455 459 463 467 469 471 472 476 490 500 502 504 509 510 517 520 526 528 539 540 544 549 558 566 568 569 578 582 587 590 594 596 598 603 609 613 617 619 621 625 627 629 633 635 638 639 641 643 647 649 663 668 669 674 688 689 690 691 692 696 698 699 704 706 708 714 716 718 722 726 728 729 730 738 740 741 742 744 746 749 758 760 762 764 768 769 772 780 782 783 785 794 796 803 809 811 817 819 821 823 825 827 829 836 837 839 843 852 853 855 857 861 863 865 866 868 869 871 873 875 881 886 890 891 893 896 900 902 904 905 906 908 913 914 916 917 918 920 926 928 930 932 935 936 938 940 944 946 950 951 952 953 954 956 960 962 963 965 966 968 969 971 980 981 986 990 992 996

没有 000.

经转换以后的H2中数据为：
009 013 023 025 028 029 049 069 089 099 014 016 018 118 124 126 128 134 146 147 149 159 167 168 169 157 178 179 188 189 199 024 026 027 223 227 247 249 258 267 268 269 277 238 248 278 288 289 239 299 034 036 038 039 136 336 346 348 349 358 366 368 369 378 388 389 045 234 447 449 455 459 467 469 005 059 015 256 359 445 558 566 568 569 578 589 356 668 669 688 689 699 047 067 078 279 037 479 678 679 139 259 000

最后多出一组 000.

提取不重复字符并组合（VBA）.rar (11.43 KB, 下载次数: 3)

2012-7-14 18:06 上传

点击文件名下载附件

请验证、解决！

再次表示感谢！向您学习了！！！

老九别走

感谢 oobird 老师出手，代码经试用，效果很好。
本人初学VBA，略知一二，数组部分还没有弄明白，感谢各位老大无私帮助！！！

{:11:}{:06:}

tomle

很经典的数组呀

oobird

看起来没这么复杂吧

1. Sub test()
   
2.     Dim s(), arr, d As Object, i%
   
3.     arr = Split(Trim(Range("H2")), " ")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     For i = 0 To UBound(arr)
   
6.         s = Array(Val(Mid(arr(i), 1, 1)), Val(Mid(arr(i), 2, 1)), Val(Mid(arr(i), 3, 1)))
   
7.         x = Application.Small(s, 1) & Application.Small(s, 2) & Application.Small(s, 3)
   
8.         d(x) = ""
   
9.     Next
   
10.     Range("H3") = Join(d.keys)
    
11. End Sub
    

复制代码

那么的帅

老九别走 发表于 2012-7-14 10:47
经反复验证，【那么的帅】老师的代码经运行后，结果多出一组数字 000 。还请老师再出手修改代码。
费心了， ...

H2 单元格里第一个就是000，H3结果里只有1组000，你说的 多出1组000，不知道是怎么回事？