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

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和计算。计算 应该将分结束前被重置（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