111.jpg

如题，题目要求统计连续的单元格，并求出连续超过6个的单元格个数

思路：

通过end的属性逐个选取连续的区域，然后对其进行统计

代码：

 Dim max_r!, max_c!, r!, c!, cnt!, s!
 Dim arr

 max_r = [a66356].End(xlUp).Row
 max_c = [c1].End(xlToRight).Column
 ReDim arr(1 To max_r - 1)
 Cells(2, max_c + 1).Resize(max_r - 1, 1).ClearContents

 For r = 2 To max_r
 For c = 3 To max_c
 cnt = Application.CountA(Range(Cells(r, c), Cells(r, c).End(xlToRight)))
 If cnt = 0 Then GoTo line1
 If cnt > 6 Then
 s = cnt - 6 + s
 End If
 c = c + cnt - 1
 Next c
line1:
 arr(r - 1) = s
 s = 0
 Next r
 Cells(2, max_c + 1).Resize(max_r - 1, 1) = Application.Transpose(arr)
​
End Sub

效果：

演示1.gif