ループ設定のフォントと範囲の内部が長すぎます

Question

私は大量のデータ（ほとんど14.000行13列）を持つシートを持っています。

私はこのシート内でForループを実行していますが、完了するまでに2分以上かかることがあります。また、アプリケーションがForループ中に応答していません。

ループを書き直してより高速に実行できる方法はありますか？事前に

For counter = 1 To Rows.Count 
    If Cells(counter, 13).Value > 500 Then 
     Cells(counter, 13).Interior.ColorIndex = 37 
     Cells(counter, 13).Font.Color = Black 
     Cells(counter, 13).Font.Bold = True 
    End If 
    count = count + 1 
    Application.StatusBar = count 
Next counter 

感謝:)：

は、ここに私のコードです。

Answer 1

範囲をループしないようにしてください。配列をループすることでコードを高速化し、配列の後ろでフォーマットすることができます。さらに、ループをステータスバーの数分だけ分割することもできます。

コード

Option Explicit 

Public Sub Greater500() 
Dim ws As Worksheet 
Set ws = ThisWorkbook.Worksheets("MySheet") 
Dim v As Variant 
Dim i As Long, n As Long, m As Long, r As Long 
Dim t As Double 
' stop watch 
    t = timer 
' get last row in column M 
    n = ws.Range("M" & ws.Rows.Count).End(xlUp).Row 
' get values to one based 2dim array 
    v = ws.Range("M1:M" & n).value 
' clear existing colors over the WHOLE column to minimize file size 
     ws.Range("M:M").Interior.ColorIndex = xlColorIndexNone 

    For i = 1 To n 
     ' avoid troubles with formula errors, e.g. divisions :/ zero 
     If IsError(v(i, 1)) Then 
     ' check condition (neglecting date, string and boolean data types) 
     ElseIf Val(v(i, 1)) > 500 Then 
      ws.Cells(i, 13).Interior.ColorIndex = 37 
      ws.Cells(i, 13).Font.Color = vbBlack 
      ws.Cells(i, 13).Font.Bold = True 
     End If 
    Next i 
    MsgBox "Time needed: " & Format(timer - t, "0.00") & " seconds." 
End Sub 

Answer 2

Rows.Countはすべての行、データを持つだけでなく、ものを含んでいます。 （Excel2016では1,048,576行）。ステータスバーが遅すぎるとは限りません。

Sub test() 
    Dim c As Range, count As Integer 
    Worksheets("Sheet1").Activate 
    ActiveSheet.UsedRange.Select 
    For Each c In Application.Selection.Cells 
     If Cells(c.Row, 13).Value > 500 Then 
      Cells(c.Row, 13).Interior.ColorIndex = 37 
      Cells(c.Row, 13).Font.Color = Black 
      Cells(c.Row, 13).Font.Bold = True 
      count = count + 1 
     End If 
     Application.StatusBar = count 
    Next c 
End Sub 

Answer 3

コードが遅くなるのは、Rows.Countを書き込むときにすべての行が必要になるためです。

範囲を制限し、問題を解決するために最後に一度にフォーマットを更新してください。

以下のコードは、私のマシンで50000個のセルを取得し、多少なりとも8秒で完了します。

また、ほぼ同じ時間で各ループを試しました。

Sub test() 

    Dim counter As Long 
    Dim count As Long 
    Dim st As Double 
    Dim et As Double 
    Dim tottime As Double 
    Dim rangetoformat As Range 

    'remove timer 
    st = Timer 

    For counter = 1 To 50000 
     If Not rangetoformat Is Nothing Then 
      If Cells(counter, 13).Value > 500 Then 
       Set rangetoformat = Union(rangetoformat, Cells(counter, 13)) 
      End If 
     Else 
      Set rangetoformat = Cells(counter, 13) 
     End If 
     count = count + 1 
     Application.StatusBar = count 
    Next counter 

    rangetoformat.Cells.Interior.ColorIndex = 37 
    rangetoformat.Cells.Font.Color = Black 
    rangetoformat.Cells.Font.Bold = True 

    'remove timer 
    et = Timer 
    totaltime = et - st 
    MsgBox totaltime 

End Sub