Excel 特定宏运行得更快

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

有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

---

您有三个If块检查相同的条件。我把它整合在这里了。将这三个替换为：

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

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:只要看一下代码，我就把两个分支中所有相似的东西都提取出来，这样它们就会一直运行。

您有三个If块来检查相同的条件。我把它整合在这里了。将这三个替换为：

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

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:只要看一下代码，我就把两个分支中所有相似的东西都提取出来，这样它们就会一直运行。

您有三个If块来检查相同的条件。我把它整合在这里了。将这三个替换为：

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

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:只要看一下代码，我就把两个分支中所有相似的东西都提取出来，这样它们就会一直运行。

您有三个If块来检查相同的条件。我把它整合在这里了。将这三个替换为：

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

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:只要看一下代码，我就把两个分支中所有相似的东西都提取出来，这样它们就会一直运行。

改进#1。VBA中的

或

操作符非常渴望，这意味着它将评估所有术语，甚至它可能会在第一时间停止，这是

正确的

——执行时间会有第一次浪费。因此，如果expr1或expr2或。。。或者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

语句将依次测试其

案例

，然后在

案例

分支内测试其表达式；如果将出现概率最大的字符串放在

Select

语句的开头或

Case

分支的开头，则会保存无用的比较

改进#3。改进#1。VBA中的

或
操作符非常急切，这意味着它将评估所有术语，即使它可能在第一次停止（这是
真的
）。因此，如果expr1或expr2或。。。或者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
语句将依次测试其
案例
，然后在
案例
分支内测试其表达式；如果将出现概率最大的字符串放在
Select
语句的开头或
Case
分支的开头，则会保存无用的比较

改进#3。改进#1。VBA中的
或
操作符非常急切，这意味着它将评估所有术语，即使它可能在第一次停止（这是
真的
）。因此，如果expr