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

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

3 个答案: