使用多个“For”和“if”语句加速 VBA 宏

Posted 2023-04-19

【中文标题】使用多个“For”和“if”语句加速 VBA 宏

【英文标题】：Speeding up VBA Macro with multiple 'For' and 'if' statements

【发布时间】：2015-12-21 21:39:14

【问题描述】：

此宏需要 2 分钟以上才能运行。优化宏的最佳方法是什么？

Sub Time_Color(z, k)

Application.DisplayAlerts = False

For Each cell In Sheet1.Range("C" & z & ":" & "LZ" & z)
    If cell.Value <> "x" Then
           If cell.Value < Sheet3.Range("D" & k) Then
              cell.Interior.ColorIndex = 37
              cell.Offset(1, 0).Value = Sheet4.Range("D" & k).Value & "_" & Sheet4.Cells(k, 5).Value
           End If

        For j = 5 To 1000 Step 2
         If cell.Value > Sheet3.Cells(k, j).Value And cell.Value < Sheet3.Cells(k, j + 1).Value Then
         cell.Interior.ColorIndex = 37
         cell.Offset(1, 0).Value = Sheet4.Cells(k, j + 1).Value & "_" & Sheet4.Cells(k, j + 2).Value
        End If
       Next j

       For j = 4 To 1000 Step 2
       If cell.Value >= Sheet3.Cells(k, j).Value And cell.Value <= Sheet3.Cells(k, j + 1).Value Then
       cell.Interior.ColorIndex = 43
       cell.Offset(1, 0).Value = Sheet4.Cells(k, j).Value & "_" & Sheet4.Cells(k, j + 1).Value
       End If
       Next j
End If
Next cell
Application.DisplayAlerts = True

End Sub

我正在为 24 种不同的 z,k 组合运行此宏。

【问题讨论】：

由于您在两个循环中比较完全相同的值，因此您只需要其中一个。

运行时关闭屏幕更新和计算。计算应在您的 Sub 结束之前重置（ScreenUpdating 将自行重置）

在循环中尽可能少地进行单元格操作，但尝试在一个范围内收集需要更改的单元格并在循环外一次性操作它们。

Sheet3 行中的值是否总是升序？如果是这样，您不必循环，可以使用WorksheetFunction.Match 来查找位置，而不是将 j 步进到 1000。

@TimWilliams 您应该将您的评论变成答案，以便 G.Fox 将其标记为正确。

【参考方案1】：

尝试缓存尽可能多的数据，例如 Sheet3.Range("D" & k) 在整个函数中都是常量。

最内层循环的每个实例都会查询该单元格。如果你把它放在这个函数的开头，它将被查找一次，然后用于函数的其余部分。

编辑： 在这个问题的 cmets 中 - 我认为 - Tim Williams 提供了一个更好的答案，这是 VBA 特有的：

在运行时关闭屏幕更新和计算。计算 应在您的 Sub 结束之前重置（ScreenUpdating 将重置 本身）

【讨论】：

我尝试通过 'Dim r as Range' 然后 'r= Range("D" & k)' 执行此操作，但我得到运行时错误 - 91: Object variable or With block variable没有设置。抱歉，如果这是一个愚蠢的问题，我对这一切都是新手。

设置对象变量时使用Set，所以Set r = Range("D" & k)

【参考方案2】：

我不完全确定您要完成什么，但您的循环似乎在大范围内迭代以找到满足两个给定条件之一的单元格的最后一个实例（您的两个循环） .

如果这是目标，为什么不从后面开始呢？根据您的工作表的外观，这可能会快得多！

我还做了一些其他的改变。让我知道它是如何工作的。

注意还要在底部包含函数（从this answer 窃取），或将其替换为您选择的函数。

Sub Time_Color(z, k)
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim loopVal, loopVal2, loopVal3 As Variant
    Dim setOdd, setEven, OddEven As Boolean

    Dim compVal, compVal2, compVal3 As Variant
    compVal = Sheet3.Range("D" & k).Value
    compVal2 = Sheet4.Range("D" & k).Value
    compVal3 = Sheet4.Cells(k, 5).Value


    For Each cell In Sheet1.Range("C" & z & ":" & "LZ" & z)
        If cell.Value <> "x" Then
            If cell.Value < compVal Then
                cell.Interior.ColorIndex = 37
                cell.Offset(1, 0).Value = compVal2 & "_" & compVal3
            End If

            For j = 1000 To 4 Step -1
                loopVal = Sheet3.Cells(k, j).Value
                loopVal2 = Sheet3.Cells(k, j + 1).Value
                loopVal3 = Sheet4.Cells(k, j + 1).Value
                OddEven = OddOrEven(j)

                If OddEven = True Then
                    If cell.Value > loopVal And cell.Value < loopVal2 Then
                        cell.Interior.ColorIndex = 37
                        cell.Offset(1, 0).Value = loopVal3 & "_" & Sheet4.Cells(k, j + 2).Value
                        setOdd = True
                    End If
                Else
                    If cell.Value >= loopVal And cell.Value <= loopVal2 Then
                        cell.Interior.ColorIndex = 43
                        cell.Offset(1, 0).Value = Sheet4.Cells(k, j).Value & "_" & loopVal3
                        setEven = True
                    End If
                End If

                If setEven = True And setOdd = True Then Exit For
            Next j
        End If
    Next cell
    Application.DisplayAlerts = True
End Sub


Function OddOrEven(a As Integer) As Boolean ' Returns TRUE if a is an odd number
    If a - (2 * (Fix(a / 2))) <> 0 Then OddOrEven = True
End Function

【讨论】：

我正在尝试制定一个可以更新的时间表，以反映本周每个工作站的当前作业顺序。我设置了一个“更新时间”宏，以便它首先通过并在单元格中用“x”标记任何过去的日子/时间，以及用户标记为非计划时间的任何单元格，即取力器/假期。从这里开始，“更新时间”在空单元格中分配值，增量为 0.5，这是一周中剩余的可用“工作时间”。然后，我将表 3 按每个工作中心的设置和运行时间（以小时为单位）进行细分。 Time_Color 与每个颜色相匹配。