Vba 对于循环设置字体和范围的内部占用的时间太长

我有一个包含大量数据的工作表（大约14000行和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

---

提前感谢：）。

避免在范围内循环。通过在数组中循环并在其后进行格式化，可以加快代码的速度。此外，还可以将状态栏计数的循环拆分为多个部分

代码

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

---

行。Count

包括每一行，而不仅仅是包含数据的行。（1048576行，Excel 2016）。状态栏不应该太慢

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

---

代码变慢的原因是，在编写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

---

使用条件格式？？？尝试在循环开始时用

Application.ScreenUpdate=False

包装循环，在循环结束时用

Application.ScreenUpdate=True

包装循环。另外，不要在循环的每次迭代中更新状态栏。主要应避免在循环中格式化过多的单个单元格，而不是整列或整行为了避免文件大小爆炸。如果你读了3遍，我敢肯定你会设法将代码升级一级-@vityta，当然，只是试图指明方向。稍后再跟进。方向很好，只是其中一部分可以升级。哇！这一次减少的时间只有15秒！唯一的问题是单元格的格式不符合所需的颜色。这是怎么来的？@vityta，我同意只需要一个维度，两种方法都有各自的优势。对于我来说，datafield方法允许使用一种无约束的方法来区分一个或多个列的源范围，并使用不同的编码。顺便说一句，我认为你的链接是有趣的用户数量。