|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
前几天发了一个求助贴,见:统计每位数(每列)的间隔规律及相应的次数,多谢各位的热心指点启发,自己把它代码写出来了,能顺利实现要求的功能,从中也学到不少知识。应该不是最优解,但终于可以用了,有需要和感兴趣的一起探讨(代码见sheet2表)。祝大家鼠年平安吉祥!!
Sub 统计数字走势()
Dim i%, d, arr(), j%, k%, m%, e%
Set d = CreateObject("Scripting.Dictionary") '设置字典对象,用于存放不同出现次数的key和item
arr() = Sheet2.Range("a2:a202")
'********************************************************************************************************
'设置3个嵌套循环,K循环从0-9,代表0-9 10个数字;
'i循环从第一个0开始,J循环从第一个0后的数字开始,依次进行比对,如同相同放入字典;如果不同循环继续,直到最后一个0。
'********************************************************************************************************
For k = 0 To 9
m = Application.WorksheetFunction.Match(k, arr(), 0) '确定K在数组中第一次出现的初始位置,用match函数处理;目的是确认i,j循环的起始点
On Error Resume Next
e = Sheet2.Columns(1).Find(what:=k, SearchDirection:=2).Row '确定K在第1列中(即arr()数组中)最后一次出现的初始位置,用find函数处理
'设置参数e目的是设立循环终止和i,j循环变更重新赋值的判断条件
For i = m To UBound(arr) - 1
If i >= e Then
i = m
Exit For
End If
For j = (m + 1) To UBound(arr)
If arr(i, 1) <> arr(j, 1) Then
GoTo 15
ElseIf arr(i, 1) = arr(j, 1) Then
d(arr(i, 1) & "间隔" & (j - i - 1) & "期") = d(arr(i, 1) & "间隔" & (j - i - 1) & "期") + 1
i = j '如果arr(i, 1) = arr(j, 1)表明出现了两个相同的数,此时将J值赋给I,从J中继继续循环
If j >= e Then
j = m + 1
Exit For
End If
End If
15: Next j
Next i
Next k
[l2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[m2].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
|
|