有人可以帮助我优化Excel中的VBA循环

我的工作表有6000行。 这个循环花了我20多分钟才完成。 对我来说太长了，因为我有很多列来运行这个循环。 有人能帮我吗？

Dim i As Integer For i = ActiveCell.Row To 5771 If Cells(i, ActiveCell.Column - 1).Value = 0 And Cells(i, ActiveCell.Column).Value = "" Then Cells(i, ActiveCell.Column).Value = 0 ElseIf Cells(i, ActiveCell.Column - 1).Value = 1 Then Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = 1 ElseIf Cells(i, ActiveCell.Column - 1).Value = -1 Then Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = -1 End If Next i 

Answer 1

很难确切地告诉你想要做什么。 您正在使用的循环结构看起来效率非常低：您正在循环范围内的行 ，并对每个单元执行一些评估/逻辑testing。

如果相邻（到左侧）单元格的值是1或-1，那么您将填充单元格，然后使用该值填充下一个9单元格。 但是当你在循环中点击Next时，你将在这些单元上执行你的testing。 所以，要么你不应该填满10行的价值，或者你应该避免testing这些行，因为可能没有什么需要做的（否则你不应该先填充它们）所以你可以看到为什么我有点困惑。

在任何情况下，我都认为当Cells(i, ActiveCell.Column - 1).Value = 1或Cells(i, ActiveCell.Column - 1).Value = -1时， 不需要testing下面的9行 。

我没有testing过这些，所以他们可能有一些错别字/等。

最快的方法是只对内存中的数据执行操作。 您可以将范围的值存储在数组中，然后对该数组执行操作，然后用单个语句将这些值“写回”工作表。 在内存中循环比在工作表上循环和写入要快得多。

 Dim rng as Range Dim arr as Variant Dim val as Variant Dim r as Long, i As Integer Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address) 'store the range values in a variant array: ' this will be of the structure arr(_row#_, _column#_) arr = rng.Value For r = 1 to UBound(arr, 1) 'Loop until last row in range/array 'arr(r,1) represents the first column of the range -- ie, the column to left of ActiveCell ' so we can use a Case statement to check this value of either 0, 1, or -1. Select Case arr(r, 1) Case 0 'if the adjacent left cell = 0 AND this cell's value = "" ' then make this cell's value = 0. If arr(r, 2) = "" Then arr(r, 2) = 0 Case 1, -1 For i = 0 to 10 'if the value is 1 or -1, puts the in this cell AND the next 9 cells arr(r + i, 2) = arr(r, 1) Next 'increment our iterator variable r = r + 9 Case Else 'Do nothing... End Select Next 'put the transformed values in to the worksheet rng.Value = arr 

这基本上是相同的，它使用循环中的工作表对象/单元格。 它更类似于你的循环，但也会比上述效率低。

 'Alternatively, but this will be slower: Dim rng as Range Dim cl as Range Dim i as Integer Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For each cl in rng.Cells With cl Select Case .Offset(0, -1).Value Case 0 If .Value = "" Then .Value = 0 Case 1, -1 .Resize(10,1).Value = .Offset(0, -1).Value Case Else 'Do nothing End Select End With Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic