难题求助大神，统计01出现次数

wang03158

0111111010111111111  1111                0111111111111111111111101111111011111.。。。。。
1            2  3  （个数低于20，直接过）  4 （4个0后出现连续22个1）  1              2.。。。。。

这是一列0和1，只找连续出现20次以上的1，每次出现0之后记数1次，2次，3次。。。只有在1连续20次以上后，再重新开始0出现的记数

说的不太明白，请看附件表格

清风竹-

VBA 代码。

wang03158

清风竹- 发表于 2020-7-15 09:45
VBA 代码。

谢谢大哥。宏我全部打开了，但是点统计次数没反应是怎么回事？

清风竹-

wang03158 发表于 2020-7-15 10:01
谢谢大哥。宏我全部打开了，但是点统计次数没反应是怎么回事？

要启用宏，我使用正常。点击有结果。

wang03158

清风竹- 发表于 2020-7-15 14:49
要启用宏，我使用正常。点击有结果。

再请教一下大哥，上次是统计的0，如果改成统计1的话，VBA该怎么改？
Sub 统计次数()
   m = [a65536].End(3).Row
    arr = Range("a1:a" & m)
   ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        If arr(i, 1) = 1 Then
           a = a + 1
            If a > 5 Then b = 0
        End If
        If arr(i, 1) = 0 Then
          b = b + 1
          brr(i, 1) = b
           a = 0
        End If
    Next
   Range("b1:b" & m) = brr
End Sub

清风竹-

wang03158 发表于 2020-7-20 23:19
再请教一下大哥，上次是统计的0，如果改成统计1的话，VBA该怎么改？
Sub 统计次数()
   m = [a65536]. ...

请试一试
Sub 统计次数2()   m = [a65536].End(3).Row
    arr = Range("a1:a" & m)
   ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        If arr(i, 1) = 0 Then
           b = 0
        End If
        If arr(i, 1) = 1 Then
          b = b + 1
          brr(i, 1) = b
           a = 0
        End If
    Next
   Range("b1:b" & m) = brr
End Sub

wang03158

清风竹- 发表于 2020-7-21 08:36
请试一试
Sub 统计次数2()
   m = [a65536].End(3).Row

有一点不对，遇到0还是继续统计了，应该是遇到0之后重新开始统计
1  1
1  2
0
1  1
1  2
0
C:\Users\Administrator\Desktop\阿11111.png

清风竹-

wang03158 发表于 2020-7-21 09:34
有一点不对，遇到0还是继续统计了，应该是遇到0之后重新开始统计
1  1
1  2

6楼代码已更新。

wang03158

清风竹- 发表于 2020-7-21 09:59
6楼代码已更新。

好了，谢谢大哥耐心指导

wang03158

wang03158 发表于 2020-7-15 10:01
谢谢大哥。宏我全部打开了，但是点统计次数没反应是怎么回事？

大哥再麻烦你帮我看下：
Sub 统计次数()
   m = [a65536].End(3).Row
    arr = Range("a1:a" & m)
   ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        If arr(i, 1) = 1 Then
           a = a + 1
            If a > 5 Then b = 0
        End If
        If arr(i, 1) = 0 Then
          b = b + 1
          brr(i, 1) = b
           a = 0
        End If
    Next
   Range("b1:b" & m) = brr
End Sub

这段代码复制到新的表格去之后出现错误，有十万+数据，难道是数据太多？