|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
1) 剛開啟檔案時, 任一空格輸入任一數字, 按回車再執行
2) 暫訂每3000行載入計數結果(可自行更改)
3) 狀態列顯示處理進度(主視窗的左下角)
4) 執行中可按ESC中斷程序
Sub TEST_A1()
Dim xR As Range, xA As Range, Arr%(1 To 3000, 0), i%, Rx&, R&, N&, Tm
Tm = Timer
Set xA = [c2]
Application.EnableCancelKey = xlErrorHandler
On Error GoTo 99
With Range([b2], Cells(Rows.Count, 2).End(3))
Rx = .Count
For Each xR In .Cells
R = R + 1: N = N + 1
Application.StatusBar = "Program is Working---" & Rx & " / " & R
For i = 1 To Len(xR)
If xR.Characters(i, 1).Font.ColorIndex = 3 Then Arr(N, 0) = Arr(N, 0) + 1
Next i
If N = UBound(Arr) Or R = Rx Then
xA.Select: xA.Resize(N) = Arr
Set xA = xA(N + 1): Erase Arr: N = 0
End If
Next
End With
99: Application.StatusBar = False
Application.EnableCancelKey = xlDisabled
MsgBox Timer - Tm
End Sub
|
评分
-
2
查看全部评分
-
|