Question

此宏需要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

我正在为z，k。

的24种不同组合运行此宏

Answer 1

尝试尽可能多地缓存数据，例如Sheet3.Range("D" & k)在此函数中保持不变。

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

编辑：关于这个问题的评论是 - 我认为 - 蒂姆威廉姆斯更好的答案，这是针对VBA的：

运行时关闭ScreenUpdating和Calculation。计算应该在Sub结束之前重置（ScreenUpdating将重置本身）

Answer 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

用多个＆＃39; For＆＃39;加速VBA宏。和＆＃39;如果＆＃39;声明

2 个答案: