excl把同一个单元格内的三位数和四位数分别放到另外两个单元格里的问题？

红臣工作室

同一个单元格里有四百左右个三位数和四位数（如F4单元格里有026,620,260,602,4589,9458,202,1100,1000等数字），每组数字之间都是用逗号分隔的。问题1:先把单元格里的所有每组数字按从小到大排列（如把F4里的数字从小到大排列为026,026,026,026,4589,4589,022,0011,0001等）。
问题2:把已经从小到大排列好的数字去除重复数并把重复的数字保留一次（就是把从小到大排列好的数字保留不重复的和重复的数字保留一次，如F4里从小到大排列的数字保留不重复数和重复的数字保留一次的为026,4589,022,0011,0001等）。
问题3:把保留不重复数和重复的数字保留一次的数中的三位数和四位数分别放到另外的两个单元格里（如：把026,022,放到G4单元格里把4589,0011,0001放到H4单元格里）。
注意：在F4单元格里的所有的数字中可能有隐藏的空格（我是怕万一有隐藏的空格的话，求出的数据有错误，或是无法正常求出）？
最后求大神们可以帮我做一段vba代码！因为这个问题困扰我好长时间了，尝试用过公式解决，结果做不出来，我在这里求求各位大神了，帮帮我好吗？我真心的谢谢你们了

红臣工作室

上传附件，求各位大神帮帮我，谢谢了

Chip_Kenny

1. Sub zz()
   
2. Dim a, b, c(), d As Object, n As Byte, tt As Boolean
   
3. Dim k, t, tr
   
4. tr = Timer
   
5. Set d = CreateObject("scripting.dictionary")
   
6. a = Range("f4:h" & [f1048576].End(3).Row).Value
   
7. ReDim aa(1 To UBound(a), 1 To 2)
   
8. With CreateObject("vbscript.regexp")
   
9.     .Pattern = "[0-9]{3,4}"
   
10.     .Global = True
    
11.     For i = 1 To UBound(a)
    
12.         For Each b In .Execute(a(i, 1))
    
13.            ReDim c(Len(b) - 1)
    
14.             For ii = 0 To UBound(c)
    
15.                 c(ii) = Mid(b, ii + 1, 1)
    
16.             Next
    
17.             For jj = 0 To UBound(c)
    
18.                 n = c(jj)
    
19.                 For jjj = jj To UBound(c)
    
20.                     If Val(c(jjj)) < n Then n = c(jjj): k = jjj: tt = True
    
21.                 Next
    
22.                 If tt Then tt = False: c(k) = c(jj): c(jj) = n
    
23.             Next
    
24.             d(ii - 2 & "@" & Join(c, "")) = ""
    
25.         Next
    
26.         a(i, 1) = ""
    
27.         For Each k In d.keys
    
28.             t = Split(k, "@"): n = t(0)
    
29.             a(i, n) = a(i, n) & "," & t(1)
    
30.         Next
    
31.         a(i, 1) = Mid(a(i, 1), 2)
    
32.         a(i, 2) = Mid(a(i, 2), 2)
    
33.         d.RemoveAll
    
34.     Next
    
35. End With
    
36. [g4].Resize(UBound(a), 2).NumberFormat = "@"
    
37. [g4].Resize(UBound(a), 2) = a
    
38. MsgBox Timer - tr
    
39. End Sub

复制代码

红臣工作室

Chip_Kenny 发表于 2018-5-20 12:39

首先感谢你给我的代码是对的，我是把他放到了sheet1里了，但是为什么我只能够运行一次呀，在运行第二次的时候就会出现错误呀，错误的是四位数的行里的内容都变成三位数的了，还有怎么在exvl里，加一个按钮来执行他呀，谢谢你我真的是太菜了，我研究了两天还是没有弄明白

红臣工作室

Chip_Kenny 发表于 2018-5-20 12:39

是在excl里安一个按钮来执行它，还有就是我把数据列里的内容改放到g列里了，（原先在f列里）。g列里的内容放到h列里了，h列里的内容放到i列里了，就有这些改动，还有就是数据行里的内容每天是有增加的，（有时一天增加一行有时一天增加两行）

红臣工作室

求安装按钮的新文件