求解VBA

LED147258

请教一下：

想将4列文本型数字，即03这样的数字，按条件并成一个文本数字，即10305172235.
自己和朋友帮忙写的代码都只能回填到28484行，远远不够全部结果。
之前自己尝试成功过，不知为何不行了，是结果太多一列装不下吗？
我总感觉是代码有错误，只得到一个循环的结果，2、3循环用的函数应该不对。
请给修改一下，自己会从中找到原因。
谢谢！！！


比如4列图中，1列的0103的后两位03和2列的0305前两位的03相同，合并成010305
                      3列的0513的前两位05和上面的010305的后两位05相同，合并成01030513
                      4列的1314的前两位13和上面的01030513的后两位13相同，并成0103051314

蓝桥玄霜

没有excel数据文件？

我是小黑屋

蓝桥玄霜 发表于 2022-11-27 09:25
没有excel数据文件？

老师，有空帮忙看看这个帖子吗https://club.excelhome.net/thread-1646038-1-1.html

LED147258

蓝桥玄霜 发表于 2022-11-27 09:25
没有excel数据文件？

帮个忙，整好几天了。累了。
附件已经上传。
我用一个一个单元格赋值好用，但是老慢了。
或许我写的数组也对，可能组合的结果太大，无相应。
请帮个忙。
谢谢
哪怕给点建议。

罗达

初看一下，实际不要想的这么复杂，规则是4列数据，一次取两位（作为一个整体对待），相邻重复则去掉。但不知这个过程要重复几次？只去一次重，还是无限次去重，请楼主明确。解法不难

LED147258

罗达 发表于 2022-11-27 22:28
初看一下，实际不要想的这么复杂，规则是4列数据，一次取两位（作为一个整体对待），相邻重复则去掉。但不 ...

就是彩票号码组合。
0103，0305，0507，0714，12的03相同组成010305，23的05相同，组成01030507，34的07相同组成0103050714完成。
0103，0305，0709，0918，12的03相同组成010305，23的05和07不同，不能组合，以至放弃0918.
最终数组中只保留5个号码组合成功的文本型数字，如01、03、07、22、34结果是0103072234.
就这样回填到一列。
近期发现只能回填表格到28000左右行，下面都是#N/A。改来改去给自己搞疯了！

zxsea_7426

LED147258 发表于 2022-11-27 23:59
就是彩票号码组合。
0103，0305，0507，0714，12的03相同组成010305，23的05相同，组成01030507，34的07 ...

这代码搞的好复杂:

zxsea_7426

简简单单一个数组，给你整成四个数组，稿这么复杂



由于结果太多(application.transpose有数量限制上限65536)，字典不能一次输出，需要分次输出，所以速度反而没有快。

LED147258

zxsea_7426 发表于 2022-11-28 02:42
简简单单一个数组，给你整成四个数组，稿这么复杂

这FOR循环，我就存在一个死点，可能在两方面，1，不清晰循环的节奏，哪里开始哪里结束2，怎么读取数组。
慢慢加深吧。
哪里也赶不上论坛，人材多不说，针对问题又准确又高效。
谢谢！！！十分感谢！！！

罗达

1. Sub TEST2()
   
2. '数字两位一组合并去掉邻位重复
   
3. Dim arr, brr(), j, n, r, s, a, c, s1
   
4. 
   
5. Application.ScreenUpdating = False
   
6. With Worksheets("排列")
   
7.     r = .Range("CN1000000").End(xlUp).Row
   
8.     arr = .Range("CN1:CQ" & r)
   
9.     ReDim brr(1 To r, 1 To 1)
   
10.     For j = 3 To r
    
11.         s = arr(j, 1) & arr(j, 2) & arr(j, 3) & arr(j, 4)
    
12.         If Len(s) < 1 Then Exit For
    
13.         s1 = Left(s, 2)
    
14.         For n = 1 To Len(s) Step 2
    
15.             On Error Resume Next
    
16.             a = Right(s1, 2)
    
17.             c = Mid(s, n + 2, 2)
    
18.             s1 = Left(s1, Len(s1) - 2) & DELchong(a, c)
    
19.         Next
    
20.         brr(j, 1) = s1
    
21.         s1 = "": a = "": c = ""
    
22.     Next
    
23.     .Range("CS1:CS" & r).Select
    
24.     Selection.NumberFormatLocal = "@"
    
25.     .Range("CS:CS").ClearContents
    
26.     .Range("CS1").Resize(r, 1) = brr
    
27. End With
    
28. Application.ScreenUpdating = True
    
29. 
    
30. End Sub
    
31. 
    
32. 
    
33. Function DELchong(a, b)
    
34. '2个数字比较，相同则去掉
    
35. Dim i As String
    
36. 
    
37. If a = b Then i = a            '2者相同
    
38. If a <> b Then i = a & b       '2者不同
    
39. 
    
40. DELchong = i
    
41. 
    
42. End Function
    

复制代码

LED147258 发表于 2022-11-28 10:53
这FOR循环，我就存在一个死点，可能在两方面，1，不清晰循环的节奏，哪里开始哪里结束2，怎么读取数组。
...

我更新了回复，加上了我的代码，看起来更简单，不知是不是你想要的