For循環設置字體和範圍的內部採取的方式太長

我有一個很多數據（近14.000行和13列）的工作表。For循環設置字體和範圍的內部採取的方式太長

我在這張表中運行一個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

感謝提前:)。

來源

2017-10-18 Mand

使用條件格式？ –

嘗試在開始時使用'Application.ScreenUpdating = False'封裝循環，最後使用'Application.ScreenUpdating = True'。 –

也不要在每次迭代循環時更新狀態欄。 – Rory

避免在範圍內循環。您可以通過循環訪問數組並在其後進行格式化來加速代碼。此外，您可以將狀態欄計數分割爲多個部分。

代碼

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

來源

2017-10-18 09:19:55

如果您閱讀了3次，我確信您可以將代碼升級到一個級別 - https://support.office.com/zh-cn/article/TRANSPOSE-function-ed039415-ed8a-4a81-93e9- 4b6dfac76027 – Vityata

@Vityata當然只是試圖展示方向。稍後跟進。 –

方向不錯，只是其中一部分可以升級。 – Vityata

Rows.Count包括每行，不僅僅是數據的人。（Excel 2016中的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

來源

2017-10-18 09:36:03 ashleedawg

您的代碼變慢的原因是當您編寫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

來源

2017-10-18 11:59:05

For循環設置字體和範圍的內部採取的方式太長

回答

相關問題