统计单元格内红色字体数量

sdytsxd991122

WPS 就是快！

qlmgu

准提部林 发表于 2022-5-14 14:19
Characters 本來就慢得可以,
若檔案剛剛開啟, 先不要執行程序,
在任一空白格輸任何數字或文字,

感谢准提部林大师指点，我试试。

qlmgu

太极拍天雄 发表于 2022-5-14 15:34
wps和excel365对比一下

感谢太极拍天雄老师做的两个系统的比较。

qlmgu

准提部林 发表于 2022-5-14 15:56
1) 剛開啟檔案時, 任一空格輸入任一數字, 按回車再執行
2) 暫訂每3000行載入計數結果(可自行更改)
3) 狀 ...

再次感谢准提部林大师出手相助，我马上测试。

qlmgu

准提部林 发表于 2022-5-14 15:56
1) 剛開啟檔案時, 任一空格輸入任一數字, 按回車再執行
2) 暫訂每3000行載入計數結果(可自行更改)
3) 狀 ...

报告准提部林大师，用您的程序，我试验了17K 行数据，有进程提示，可以预期结果，程序执行完毕后顺利结束。再次感谢您。

准提部林

qlmgu 发表于 2022-5-14 18:15
报告准提部林大师，用您的程序，我试验了17K 行数据，程序跑了1018.609，有进程提示，可以预期结果，程序 ...

Characters 在excel 中本來就慢,
但我用老古董(P4)配備, 在XP系統下, 兩萬多行也不須那麼久,

可能單元格文字長度非常多多吧!

zt1066815277

For i = 2 To Range("b" & Rows.Count).End(xlUp).Row 这一行报错了,改为
For i = 2 To cells(Rows.Count,2).End(xlUp).Row我看就行

zt1066815277

1. Sub 红色字数计算()
   
2.     Dim i As Double, n%, m%
   
3.     For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
   
4.         For n = 1 To Len(Range("b" & i))
   
5.             If Range("b" & i).Characters(n, 1).Font.ColorIndex = 3 Then
   
6.                 m = m + 1
   
7.             End If
   
8.         Next n
   
9.         Range("d" & i) = m
   
10.         m = 0
    
11.     Next i
    
12. End Sub

复制代码

准提部林

qlmgu 发表于 2022-5-14 18:15
报告准提部林大师，用您的程序，我试验了17K 行数据，程序跑了1018.609，有进程提示，可以预期结果，程序 ...

用原資料複製成 21418 行,
共執行 147 秒

qlmgu

准提部林 发表于 2022-5-14 18:51
用原資料複製成 21418 行,
共執行 147 秒

准提部林大师您好，我也是拷贝示范数据，应该是我的office(2016,32位和win7（i3）系统比较慢的原因吧，但是程序可以完成任务，而且可以看到进程，已经很好了。再次感谢您。