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

这个macros需要2分钟运行。 什么是优化macros的最佳方法？

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 

我运行这个macros的z，k的24个不同的组合。

Answer 1

尝试caching尽可能多的数据，例如Sheet3.Range("D" & k)在整个函数中是不变的。

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

编辑：在这个问题的意见是 – 我认为 – 更好的答案蒂姆·威廉斯，这是特定于VBA：

运行时closuresScreenUpdating和Calculation。 计算应在您的Sub结束之前重置（ScreenUpdating将自行重置）

Answer 2

我不完全确定你要完成什么，但似乎你的循环遍历了一个很大的范围，以find满足两个给定条件之一（你的两个循环）的单元格的最后一个实例。

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

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

注意还包括底部的function（从这个答案中获取 ），或者将其replace为您select的function。

 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