求助VBA代码

风飘绝影

各位老师好，想统计每列中最后一个填充颜色的单元格后面有多少个连续没有颜色填充而且是非空的单元格的个数是多少，VBA代码怎么写？求老师们帮帮忙，万分感谢！

ykcbf1100

你的描述有问题的：
一、V列最后一个有颜色的单元格应该是205行，而不是你箭头所指的171行；
二、你V列的标准答案是多少？是5还是8？你没有说明。

风飘绝影

ykcbf1100 发表于 2023-7-9 08:29
你的描述有问题的：
一、V列最后一个有颜色的单元格应该是205行，而不是你箭头所指的171行；
二、你V列的 ...

V列是172行-180行9个，目前181行还没有数据

风飘绝影

ykcbf1100 发表于 2023-7-9 08:29
你的描述有问题的：
一、V列最后一个有颜色的单元格应该是205行，而不是你箭头所指的171行；
二、你V列的 ...

附件已更新，我把181行那些没有数据的“0”删掉了

吴虾咪

ykcbf1100 发表于 2023-7-9 08:29
你的描述有问题的：
一、V列最后一个有颜色的单元格应该是205行，而不是你箭头所指的171行；
二、你V列的 ...

老师,https://club.excelhome.net/thread-1666864-1-1.html 这个可以改吗

gwjkkkkk

统计好后放在哪里？？？

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr() As Integer
   
4.     With Worksheets("sheet1")
   
5.         arr = .Range("i1:w205")
   
6.         ReDim brr(1 To UBound(arr, 2))
   
7.         For j = 1 To UBound(arr, 2)
   
8.             s = 0
   
9.             For i = UBound(arr) To 2 Step -1
   
10.                 If .Cells(i, j + 8).DisplayFormat.Interior.Color = 65535 Then
    
11.                     Exit For
    
12.                 End If
    
13.                 If Len(arr(i, j)) <> 0 Then
    
14.                     brr(j) = brr(j) + 1
    
15.                 End If
    
16.             Next
    
17.         Next
    
18.         .Range("i207").Resize(1, UBound(brr)) = brr
    
19.     End With
    
20. End Sub
    

复制代码

chxw68

结果在第207行。

ykcbf1100

附件供参考。。。
结果在207行。

风飘绝影

chxw68 发表于 2023-7-9 11:11
结果在第207行。

老师，早上上传附件传错了，谢谢老师的帮忙！老师如果有空的话可以帮我重新看看新附件吗？