[已解决]批量数据组合的问题

晓敏 · 发表于 2015-1-6 14:34

本帖最后由晓敏于 2015-1-6 15:52 编辑

附件

批量数据组合附件.zip (6.32 KB, 下载次数: 8)

香川群子 · 发表于 2015-1-6 15:43

本帖最后由香川群子于 2015-1-6 22:23 编辑

Sub test()
Dim ar, br&(), cr&(), i&, j&, k&, m&, n&, r&, t&, cnt&, tms#
tms = Timer
ar = Sheet1.[a1].CurrentRegion
m = UBound(ar): n = UBound(ar, 2)
ReDim br&(1 To m, 1 To n)
For j = 1 To n
ReDim cr&(99, m)
For i = 3 To m
t = ar(i, j): k = cr(t, 0) + 1: cr(t, 0) = k: cr(t, k) = i
Next
cnt = 0
For i = 0 To 99
If cr(i, 0) > 1 Then
For k = 1 To cr(i, 0)
cnt = cnt + 1
t = cr(i, k)
'br(cnt, j) = ar(t - 2, j) & ar(t - 1, j) & ar(t, j)
'……1位数时会产生漏0拼接错误如 19 26 6 成为 019266 而不是期望的192606
br(cnt, j) = ar(t - 2, j) * 10000 + ar(t - 1, j) * 100 + ar(t, j) '改成这样计算就没问题了。
Next
End If
Next
If cnt > r Then r = cnt
Next
Sheet2.Activate
[a1].CurrentRegion = ""
[a1].Resize(r, n).NumberFormat = "000000"
[a1].Resize(r, n) = br
MsgBox Format(Timer - tms, "0.000s")
End Sub

复制代码

香川群子 · 发表于 2015-1-6 15:47

算法原理：

① 遍历各行、统计相同数个数并记录所在行位置
② 检查返回相同数>1时对应的合并6位数

晓敏 · 发表于 2015-1-6 15:53

香川群子发表于 2015-1-6 15:47
算法原理：

① 遍历各行、统计相同数个数并记录所在行位置

谢谢老师帮助。
人长得靓，代码写得也靓。

晓敏 · 发表于 2015-1-6 16:40

本帖最后由晓敏于 2015-1-6 16:41 编辑

香川群子发表于 2015-1-6 15:47
算法原理：

① 遍历各行、统计相同数个数并记录所在行位置

老师您好，刚才正式运用的时候，仔细一看，有点不对劲啊。

三个小于或等于49的两位数组合，比如：01 33 37 ，组合后，是013337，其中，十位数，千位数，十万位数，这三个位置的数，不能有大于4的数出现。

附件中的结果，第一个组合体是：

019266

这里十位数与千位数，已经大于4了。显然这个结果是错误的。

经过百多列数据仔细对比，发现十位与千位这两个位置都或多或少有大于4的结果出现。十万位即超始位，还没发现。

麻烦老师看看，谢谢了。

香川群子 · 发表于 2015-1-6 22:19

晓敏发表于 2015-1-6 16:40
老师您好，刚才正式运用的时候，仔细一看，有点不对劲啊。

三个小于或等于49的两位数组合，比如：01 ...

合并6位数的代码改一下：

原来：
br(cnt, j) = ar(t - 2, j) & ar(t - 1, j) & ar(t, j) …… 19 26 06 变成了 19266 → 019266

改为：
br(cnt, j) = ar(t - 2, j) * 10000 + ar(t - 1, j) * 100 + ar(t, j)

自己改一下吧。

晓敏 · 发表于 2015-1-7 16:11

香川群子发表于 2015-1-6 22:19
合并6位数的代码改一下：

原来：

谢谢老师。

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

[已解决]批量数据组合的问题

评分