对于循环设置字体和范围内部花费的时间太长

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包括每一行，而不仅仅是包含数据的行。 （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

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