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

红臣工作室 · 发表于 2018-5-20 02:26

同一个单元格里有四百左右个三位数和四位数（如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代码！因为这个问题困扰我好长时间了，尝试用过公式解决，结果做不出来，我在这里求求各位大神了，帮帮我好吗？我真心的谢谢你们了

红臣工作室 · 发表于 2018-5-20 03:46

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

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

Sub zz()
Dim a, b, c(), d As Object, n As Byte, tt As Boolean
Dim k, t, tr
tr = Timer
Set d = CreateObject("scripting.dictionary")
a = Range("f4:h" & [f1048576].End(3).Row).Value
ReDim aa(1 To UBound(a), 1 To 2)
With CreateObject("vbscript.regexp")
.Pattern = "[0-9]{3,4}"
.Global = True
For i = 1 To UBound(a)
For Each b In .Execute(a(i, 1))
ReDim c(Len(b) - 1)
For ii = 0 To UBound(c)
c(ii) = Mid(b, ii + 1, 1)
Next
For jj = 0 To UBound(c)
n = c(jj)
For jjj = jj To UBound(c)
If Val(c(jjj)) < n Then n = c(jjj): k = jjj: tt = True
Next
If tt Then tt = False: c(k) = c(jj): c(jj) = n
Next
d(ii - 2 & "@" & Join(c, "")) = ""
Next
a(i, 1) = ""
For Each k In d.keys
t = Split(k, "@"): n = t(0)
a(i, n) = a(i, n) & "," & t(1)
Next
a(i, 1) = Mid(a(i, 1), 2)
a(i, 2) = Mid(a(i, 2), 2)
d.RemoveAll
Next
End With
[g4].Resize(UBound(a), 2).NumberFormat = "@"
[g4].Resize(UBound(a), 2) = a
MsgBox Timer - tr
End Sub

复制代码

红臣工作室 · 发表于 2018-5-21 20:05

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

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

红臣工作室 · 发表于 2018-5-21 20:16

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

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

红臣工作室 · 发表于 2018-5-21 20:33

求安装按钮的新文件

		自动登录	找回密码
密码			免费注册