用VBA数组或字典计算A列数字数字连续次数

awsa888

lsdongjh 发表于 2017-6-21 11:24
运行效果如下：

明显不对~~~~~~~~~

xuejiebo

Sub test()
Dim arr1()
t = Timer
    arr = Range("a1:a" & [a1].End(xlDown).Row + 1)
    For i = 1 To UBound(arr) - 1
        If arr(i, 1) <> arr(i + 1, 1) Then
            m = m + 1
            ReDim Preserve arr1(1 To 2, 1 To m)
            arr1(1, m) = arr(i, 1)
            k = i
            k = k - s
            s = s + k
            arr1(2, m) = k
        End If
     Next
    [c1].Resize(m, 2) = ""
    [c1].Resize(m, 2) = Application.Transpose(arr1)
MsgBox Timer - t
End Sub

laoau128

xuejiebo 发表于 2017-6-21 15:59
Sub test()
Dim arr1()
t = Timer

暂时没有分，明天再加吧

laoau128

xuejiebo 发表于 2017-6-21 15:59
Sub test()
Dim arr1()
t = Timer

你这个答案最正确，前面几个答案，计算最大连续次数了

LMY123

关注字典统计

yaozong

1. Sub yz()
   
2.   Dim arr, i&, k&, m&, t
   
3.   t = Timer
   
4.   arr = Range("a1", Cells(Rows.Count, 1).End(3).Offset(1))
   
5.   ReDim brr(1 To UBound(arr), 1 To 2)
   
6.   k = 1: m = 1
   
7.   For i = 2 To UBound(arr)
   
8.     If arr(i, 1) = arr(i - 1, 1) Then
   
9.       k = k + 1
   
10.     Else
    
11.       brr(m, 1) = arr(i - 1, 1)
    
12.       brr(m, 2) = k: k = 1
    
13.       m = m + 1
    
14.     End If
    
15.   Next
    
16.   [c1].CurrentRegion.ClearContents
    
17.   [c1].Resize(m, 2) = brr
    
18.   MsgBox Format(Timer - t, "0.000000s")
    
19. End Sub

复制代码

闻风上胆

帮忙写一下代码

闻风上胆

laoau128 发表于 2017-6-21 09:31
你这个确实错了，

Sub 看这个()

帮忙写一下！！谢谢！！！

闻风上胆

linyh1742595842 发表于 2017-6-21 08:15
Sub cfz()
    Dim i&, Myr&, Arr
    Dim d, k, t

求助！每次连续的计数

闻风上胆

awsa888 发表于 2017-6-21 09:45
仅供参考~~~~~~~~~~~~~~~~~~~~~

求助，每次出现的连续计数