特定宏运行得更快

时间：2014-06-25 08:50:54

标签： excel vba

我想知道是否有办法让这些宏运行得更快。

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

我有大约10个其他模块通过运行按钮将“主”表分成特定选项卡。反过来运行这个宏需要大约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

5 个答案:

答案 0 :(得分：3)

改进＃1。 VBA中的Or运算符非常渴望，这意味着它会评估所有条款，即使它可以在第一个True停止 - - 你的执行时间首先浪费了。因此，您可能希望使用等效形式的If expr1 Or expr2 Or ... Or exprn而不是Select Case，而是懒惰地评估其分支。例如，您的第一个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。如果您对测试字符串出现的频率有所了解，可以使用该信息缩短执行时间。 Select语句将按顺序测试其Cases，然后在Case分支内部测试其表达式;如果你在Select语句的开头或者Case分支的开头放置具有最大发生概率的字符串，那么你将保存无用的比较。

改进＃3。 The answer of VBlades

答案 1 :(得分：1)

如评论所述，试试这个：

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。我评论了重要的部分 如果有什么不清楚的地方，请将其评论出来。

答案 2 :(得分：0)

  1. 只使用一个IF语句 - 您有三个检查相同的逻辑。 IF逻辑很复杂，因此复制它是没有意义的。

  2. 将Sheets("Main").Cells(i, "A").Value分配给字符串变量并在代码中使用此变量。我相信每次引用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

答案 3 :(得分：0)

在运行宏之前，从excel表中删除空行。您可以通过Cntrl + End找到空行。按control + end，删除空行并保存工作表，然后运行宏。这将帮助您快速运行宏并减小尺寸，

答案 4 :(得分：-1)

你有三个If块检查相同的条件。我在这里巩固了它。用这个替换这三个：

编辑2：我实际上已经取出了我所拥有的并取代了整个子程序。我用字符串变量替换A中当前单元格的引用。不确定它增加了多少额外时间，但我确定单元格引用的解析是开销。不妨阅读一次，然后存放它。不确定字符串比较本身是否可以更快完成。

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

这已经应该快得多了。可能还有一种更快的方法来进行字符串比较。让我考虑一下。

编辑1：只是查看代码，我将两个分支中相似的东西都拉出来，以便始终运行。

相关问题
最新问题