[已解决]本来用公式可以解决的，但是那样卡得很，VBA的话速度会快不少，数据有30多万行

sadz · 发表于 2016-4-6 10:37

本来用公式可以解决的，但是那样卡得很，VBA的话速度会快不少，数据有30多万行，再次谢谢大神们的费心尽力

VBA分析统计数字.rar (11.06 KB, 下载次数: 28)

grf1973 · 发表于 2016-4-11 11:18

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

嗯，主要是数组brr定义得太小了。

sadz · 发表于 2016-4-7 08:52

大神们，还没起床吗

grf1973 · 发表于 2016-4-7 15:35

很费脑子，很费时间啊

Sub tt()
Call 清空
arr = [b1:b16]
ReDim brr(1 To 100, 1 To 20)
Dim drr(3, 9) '0--9出现的次数，初始化设为0
For i = 0 To 3
For j = 0 To 9
drr(i, j) = 0
Next
Next
Dim crr(3) '填充表中的行数控制
x = [c2] '匹配数
qs = Left(x, 3): hs = Right(x, 3): zs = Mid(x, 2, 3) '前三、后三、中三
xrr = Array(x, qs, zs, hs)
c = -4
For n = 0 To UBound(xrr) '变量n控制匹配、前三、中三、后三
y = xrr(n) ''第n次取数（分别取：匹配、前三、中三、后三）
c = c + 5 '要填充的起始列
brr(1, c) = y '填充第一个数
p = IIf(n = 0, 1, n) '匹配、前三、中三、后三在待匹配数据中的起始位置
For i = 1 To UBound(arr)
If CStr(y) = Mid(arr(i, 1), p, Len(y)) Then '判断是否满足匹配、前三、中三、后三的条件
crr(n) = crr(n) + 1 '填充列，行数+1
k = crr(n)
For j = 0 To 3 '向下取4数，填充后4列
xx = arr(i + j, 1)
yy = Mid(xx, p, Len(y))
brr(k, c + j + 1) = yy
If j > 0 Then '计算各数出现的次数（不含本数）
For kk = 1 To Len(yy)
yyy = Mid(yy, kk, 1)
drr(n, yyy) = drr(n, yyy) + 1
Next
End If
Next
End If
Next
Next
[c2].Resize(4, 20) = brr '显示结果
[x2].Resize(4, 10) = drr
Call 排序
End Sub
Sub 排序()
For i = 2 To 5
Cells(2 * i - 2, "AI").Resize(1, 10) = Cells(i, "X").Resize(1, 10).Value
Cells(2 * i - 1, "AI").Resize(1, 10) = Cells(1, "X").Resize(1, 10).Value
Cells(2 * i - 2, "AI").Resize(2, 10).Sort Orientation:=xlLeftToRight, _
Key1:=Cells(2 * i - 2, "AI").Resize(1, 10), Order1:=xlDescending, _
Key2:=Cells(2 * i - 1, "AI").Resize(1, 10), Order2:=xlDescending
Next
End Sub
Sub 清空()
[d2:v10,x2:ag10,ai2:ar10] = ""
End Sub

复制代码

sadz · 发表于 2016-4-11 10:24

grf1973 发表于 2016-4-7 15:35
很费脑子，很费时间啊

我的实际数据是340183行，arr = [b1:b16]这个把B16，修改为b340183后提示下标错误

sadz · 发表于 2016-4-11 11:23

grf1973 发表于 2016-4-11 11:18
嗯，主要是数组brr定义得太小了。

好了，谢谢老师{:091:}{:1112:}{:1112:}{:1112:}

sadz · 发表于 2016-4-12 09:12

grf1973 发表于 2016-4-11 11:18
嗯，主要是数组brr定义得太小了。

老师，这样是可以了。但是在使用过程发现一个问题，如果这个数字前面是0的话会被省略掉，这样0是不被计算的，我的想法是把b列的数字之间全部用，隔开这样0就会出现了，想问下这样应该怎么修改呢

VBA分析统计数字进问题.zip (12.2 KB, 下载次数: 5)

grf1973 · 发表于 2016-4-12 10:13

不用的。统一用format调格式就行了。请看附件。

sadz · 发表于 2016-4-12 10:40

grf1973 发表于 2016-4-12 10:13
不用的。统一用format调格式就行了。请看附件。

怎么是这样的

grf1973 · 发表于 2016-4-12 10:42

源数据就是这样的。我是复制了几份相同的。你换个数据源就没问题了。

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

[已解决]本来用公式可以解决的，但是那样卡得很，VBA的话速度会快不少，数据有30多万行

评分

评分

评分