VBAループのExcelステータスバーを更新する

Question

データのトリミングを実行するマクロコードがあります。

が

Sub StatusBarExample() 
Application.ScreenUpdating = False 
Application.DisplayStatusBar = True 
Application.StatusBar = "Trimming..." 
Dim x As Long 
x = 1 
Do While Cells(x, 1) <> "" 
Cells(x, 2).Select 
ActiveCell.FormulaR1C1 = "=trim(RC[-1])" 
x = x + 1 
Loop 
Application.Wait Now + TimeValue("00:00:02") 
Application.StatusBar = False 
End Sub 

データの数は常に変化し、私はDo Whileループを使用する理由である：以下は私のコードです。このコードでは、進行状況をパーセンテージで知らなくても、「トリミング」というメッセージしか表示されません。誰も私がこのコードを改善するのを助けることができますか？

Answer 1

私はこのアプローチを採用します。私はより良いforループが好きで、これはステータスバーに％completeを表示します。

Sub StatusBarExample() 
Application.ScreenUpdating = False 
Application.DisplayStatusBar = True 
Application.StatusBar = "Trimming..." 
Dim x As Long 
Dim lRow as Long 
Dim prePct as Single, newPct as Single 

newPct = 0 
prePct = 0 
With ThisWorkbook.Sheets("Sheet Name Goes Here") 
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

    For x = 1 to lRow 
     .Cells(x,2).FormulaR1C1 = "=trim(RC[-1])" 
     newPct = x/lRow 

     If newPct > prePct + .01 
     DoEvents 
     prePct = newPct 
     End If 

     Application.StatusBar = "Trimming..." & Format(x/lRow,"0.00%") & " Complete" 
    Next x 
Application.StatusBar = False 
Application.ScreeUpdating = True 
End Sub 

ありがとうございました。私はいくつかの変更を加えました。 If newPct > prePct + .01行では、データの量に応じて.01を別のものに変更する必要があります。