特定的macros运行速度更快

我想知道是否有任何方法使这个macros运行更快。

有超过3500行，他们不断被添加到。 现在需要大约30秒才能完成（复制下面的模块）。

我有大约10个其他模块通过运行button将“主”表分成特定的选项卡。 反过来运行这个macros需要大约75秒，这太长了。 有没有办法更快地运行这个？

Sub FillColumns() Dim i, LastRow Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row For i = 40 To LastRow 'start row number If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _ Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _ Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _ Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _ Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous Else: Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous End If If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _ Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _ Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _ Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _ Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous Else: Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous End If If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _ Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _ Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _ Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _ Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _ Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _ Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _ Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _ Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _ Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _ Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous Else: Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous End If Next i Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = True Application.ScreenUpdating = True End Sub 

Answer 1

改进＃1。 VBA中的Or运算符是急切的，这意味着它将评估所有的术语，即使它可以在第一个是True停止 – 在执行时间中有第一个浪费。 所以，而不是If expr1 Or expr2 Or ... Or exprn你可能想使用Select Case的等价forms，这将懒洋洋地评估其分支。 例如，你的第一个If将被转换为：

 Select Case Sheets("Main").Cells(i, "A").Value Case "COOK-Anasuria allocation", "SCOTER-Shearwater Allocation", _ "MERGANSER-Shearwater Alloc.", "PENGUIN-Brent C Allocation", _ "STARLING-Shearwater Alloc.", "HOWE-Nelson allocation", _ "ANASURIA-Fulmar", "BRENT ALPHA-Flags Gas", _ "BRENT BRAVO-Flags Gas", "BRENT CHARLIE-Brent", _ "BRENT CHARLIE-Flags", "BRENT DELTA-Flags Gas", _ "U500-St Fergus", "BACTON SEAL-SEAL", _ "CURLEW-Fulmar", "GANNET-Central", _ "GANNET-Fulmar", "MOSSMORRAN-Plants", _ "U3000-St Fergus", "NELSON-Forties Oil", _ "NELSON-Fulmar", "SHEARWATER-Forties Oil", _ "SHEARWATER-SEAL" Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous Case Else Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous End Select 

改进＃2。 如果您对testingstring的出现频率有所了解，则可以使用该信息来缩短执行时间。 Select语句将依次testing它的Cases ，然后在Case分支的expression式中; 如果在Select语句的开头，或在Case分支的开头放置出现概率最大的string，则可以省去无用的比较。

改进＃3。 VBlades的答案

Answer 2

正如所评论的，试试这个：

 Sub FillColumns() Dim i As Long, LastRow As Long Dim phrases Dim rng1 As Range, rng2 As Range With Application .ScreenUpdating = False .DisplayStatusBar = False .Calculation = xlCalculationManual End With '~~> create an array of phrases phrases = Array("CURLEW C-Curlew Allocation", "COOK-Anasuria allocation", _ "SCOTER-Shearwater Allocation", "MERGANSER-Shearwater Alloc.", _ "PENGUIN-Brent C Allocation", "STARLING-Shearwater Alloc.", _ "HOWE-Nelson allocation", "ANASURIA-Fulmar", _ "BRENT ALPHA-Flags Gas", "BRENT BRAVO-Flags Gas", _ "BRENT CHARLIE-Brent", "BRENT CHARLIE-Flags", _ "BRENT DELTA-Flags Gas", "U500-St Fergus", _ "BACTON SEAL-SEAL", "CURLEW-Fulmar", _ "GANNET-Central", "GANNET-Fulmar", _ "MOSSMORRAN-Plants", "U3000-St Fergus", _ "NELSON-Forties Oil", "NELSON-Fulmar", _ "SHEARWATER-Forties Oil", "SHEARWATER-SEAL") '~~> segregate the range to format using the phrases array With Sheets("Main") LastRow = .Range("A" & Rows.Count).End(xlUp).Row For i = 40 To LastRow If Not IsError(Application.Match(.Range("A" & i).Value, phrases, 0)) Then If rng1 Is Nothing Then Set rng1 = .Range("Z" & i, "AB" & i) Else Set rng1 = Union(rng1, .Range("Z" & i, "AB" & i)) End If Else If rng2 Is Nothing Then Set rng2 = .Range("Z" & i, "AB" & i) Else Set rng2 = Union(rng2, .Range("Z" & i, "AB" & i)) End If End If Next End With '~~> format the ranges in one go With rng1 .Interior.ColorIndex = 2 .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With With rng2 .Interior.ColorIndex = 56 .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With With Application .Calculation = xlCalculationAutomatic .DisplayStatusBar = True .ScreenUpdating = True End With End Sub 

HTH。 我已经评论了重要的部分。
如果有什么不清楚的地方，就把它评论一下。

Answer 3

1. 只使用一个IF语句 – 你有三个检查相同的逻辑。 IF逻辑很复杂，所以复制它没有意义。

2. 赋值Sheets("Main").Cells(i, "A").Value赋值给一个stringvariables并在代码中使用这个variables。 我相信每次引用Sheets("Main").Cells(i, "A").Value引擎通过工作簿 – >表格 – >单元格 – >值。 我不知道优化器有多好。

   Dim sValue as String: sValue = Sheets("Main").Cells(i, "A").Value

3. 当你做格式化 – 使用With ，所以你加快了参考：

   With Sheets("Main").Cells(i, "AB") .Interior.ColorIndex = 56 .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous End With

Answer 4

在运行macros之前，从Excel工作表中删除空行。 您可以通过Cntrl + Endfind空行。 按控制+结束，删除空行并保存您的工作表，然后运行macros。 这将帮助您快速运行macros，同时也减小尺寸，

Answer 5

你有三个如果块检查看起来相同的情况。 我已经巩固在这里。 用这个replace这三个：

编辑2：我已经拉出了我所取代的整个子程序。 我用stringvariablesreplaceA中当前单元格的引用。 不知道有多less额外的时间，但我敢肯定，单元格引用的解决是开销。 不妨读一遍，然后存储它。 Sill不确定string比较本身是否可以做得更快。

 Sub FillColumns() Dim i, LastRow Dim strCellA As String Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row For i = 40 To LastRow 'start row number strCellA = Sheets("Main").Cells(i, "A").Value If strCellA = "CURLEW C-Curlew Allocation" _ Or strCellA = "COOK-Anasuria allocation" _ Or strCellA = "SCOTER-Shearwater Allocation" _ Or strCellA = "MERGANSER-Shearwater Alloc." _ Or strCellA = "PENGUIN-Brent C Allocation" _ Or strCellA = "STARLING-Shearwater Alloc." _ Or strCellA = "HOWE-Nelson allocation" _ Or strCellA = "ANASURIA-Fulmar" _ Or strCellA = "BRENT ALPHA-Flags Gas" _ Or strCellA = "BRENT BRAVO-Flags Gas" _ Or strCellA = "BRENT CHARLIE-Brent" _ Or strCellA = "BRENT CHARLIE-Flags" _ Or strCellA = "BRENT DELTA-Flags Gas" _ Or strCellA = "U500-St Fergus" _ Or strCellA = "BACTON SEAL-SEAL" _ Or strCellA = "CURLEW-Fulmar" _ Or strCellA = "GANNET-Central" _ Or strCellA = "GANNET-Fulmar" _ Or strCellA = "MOSSMORRAN-Plants" _ Or strCellA = "U3000-St Fergus" _ Or strCellA = "NELSON-Forties Oil" _ Or strCellA = "NELSON-Fulmar" _ Or strCellA = "SHEARWATER-Forties Oil" _ Or strCellA = "SHEARWATER-SEAL" Then Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 2 Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 2 Else: Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 56 Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 56 End If Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous Next i Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = True Application.ScreenUpdating = True End Sub 

这应该会快得多。 有可能更快的方式来做string比较。 让我想想。

编辑1：只看代码，我把所有在两个分支类似的东西，所以将始终运行。