如何在Excel VBA中优化（或尽可能避免）循环

Excel VBA中涉及select（以及如何避免它们）以及“重”循环中的各种问题已在本论坛上讨论过。 我想稍微扩展一下。 比方说，我想要将某个string更改为另一个string，并使用数字数据执行其他操作。 考虑下面的代码：

Option Explicit Sub LoopExample() Dim rownumber, colnumber As Integer ' Step 1: start a loop from a desired position For rownumber = 30 To 3000 For colnumber = 30 To 3000 ' Step 2: check that the cell is not empty If IsEmpty(Cells(rownumber, colnumber).Value) = False Then ' Step 3: change all "Cat" texts to "Dog" If Cells(rownumber, colnumber).Value = "Cat" Then Cells(rownumber, colnumber).Value = "Dog" ' Step 4: if the cell value is numeric... ElseIf IsNumeric(Cells(rownumber, colnumber).Value) Then ' ...check another thing and execute something accordingly If (Cells(rownumber, colnumber).Value) / 2 < 0.5 Then Cells(rownumber, colnumber) = Round(Cells(rownumber, colnumber).Value, 4) Else Cells(rownumber, colnumber) = Round(Cells(rownumber, colnumber).Value, 1) End If End If End If Next colnumber Next rownumber End Sub 

现在，这个代码工作“完美”，但几乎没有效率。 我应该通过以下方式对其进行优化：1）首先find所有包含数据的单元格，2）再次遍历这些单元格，3）现在将数据进一步划分为数字和非数字数据，4）执行我想在这些数字和非数字范围？ 或者我应该在一个循环中结合这些步骤中的一些？

Answer 1

我认为你可以通过让Excel只查看具有值的单元格来优化这一点。 要做到这一点，你可以使用SpecialCells的常量和公式的组合 – 我认为两者的组合将捕获所有“填充”或非空白单元格：

 Sub LoopExample() Dim ws As Worksheet Set ws = ActiveSheet Dim r, s As Range Set r = Application.Union(ws.UsedRange.SpecialCells(xlCellTypeConstants), _ ws.UsedRange.SpecialCells(xlCellTypeFormulas)) For Each s In r If s.Row >= 30 And s.Row <= 3000 And s.Column >= 30 And s.Column <= 3000 Then If s.Value2 = "Cat" Then s.Value2 = "Dog" End If End If Next s End Sub 

我没有列出你评估单元格的所有逻辑，但你明白了。

Answer 2

将整个范围转换成变体（结果是包含2d数组的变体）会快几个数量级，循环变体数组进行更改，然后将变体数组返回到工作表。

Answer 3

我做了一些似乎与此。

1°： 长期使用更好， 整数高度计数器。

2°：使用范围属性检查。

3°：使用应用程序属性来优化易于计算。

您不需要使用“For … 0到3000”来执行此操作。 你可以试试这个：

 Sub LoopExample() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Dim i As Range For Each i In Range("A:Z") If IsEmpty(i.Value) = False Then If i.Value = "Cat" Then i.Value = "Dog" ElseIf IsNumeric(i.Value) Then If (i.Value) / 2 < 0.5 Then i.Value = 0.5 Else End If End If End If Next Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

但是，如果坚持使用计数器，请尝试如下所示：

 Sub numberlist() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Dim a As Long Dim b As Long Dim i As Range Do While Not Cells(3000, 3000).Value > 0 b = b + 1 Cells(1, b).Value = 1 + b * 100 - 100 Cells(2, b).Value = 2 + b * 100 - 100 Set i = Range(Cells(1, b), Cells(3000, b)) Set SourceRange = Range(Cells(1, b), Cells(2, b)) Set fillRange = i SourceRange.AutoFill Destination:=fillRange Loop Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

做一个试驾。 它只是花了很多时间来计算：v