特定的宏運行更快

我想知道是否有任何方法可以使這個宏運行更快。特定的宏運行更快

有超過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

來源

2014-06-25 sim08

[Check this out]（http://stackoverflow.com/questions/24378866/quickly-format-cells-in-excel）其中我認爲會幫助你得到你想要的。這個想法是先確定你想要格式化的所有範圍，然後一次完成格式化。 – L42

感謝鏈接@ L42。每次我嘗試這樣的事情時，如果沒有阻止，它會一直給我錯誤結束，如果是這樣，我只能恢復到原來的狀態。 – sim08

堅持一秒鐘，我試圖讓你的代碼出來。我會稍微張貼一下。 – L42

-1

你有三個If塊檢查它看起來相同的情況。我在這裏鞏固了它。用這個替換這三個：

編輯2：我已經拉出了我的東西，並取代了整個子程序。我用字符串變量替換A中對當前單元格的引用。不知道它增加了多少額外時間，但我確信解決單元格引用是開銷。不妨一次閱讀並存儲它。 Sill不確定字符串比較本身是否可以更快完成。

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：只看代碼，我把所有在兩個分支中相似的東西都拉出來，以便始終運行。

來源

2014-06-25 09:04:33 VBlades

改進＃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

來源

2014-06-25 09:12:04

詢問這個問題謝謝，我是否會重複列AA和AB的過程？或者是否有辦法將這些融爲一體。這是我無法解決的問題 – sim08

請參閱@VBlades的評論;您可以將「AA」和「AB」格式置於相同的「Select」語句中（如果您確定條件相同）。不要忘記把'Else'分支的代碼也放在裏面。 –

@ CST-Link：你認爲用單元格A值替換一個包含所有名稱的字符串，然後檢查結果字符串的Len與原始名稱字符串的比較會比甚至CASE更快？橫過我的腦海。 – VBlades

只有一個，如果使用語句 - 你有三個檢查相同的邏輯。 IF邏輯很複雜，所以複製它沒有意義。
將Sheets("Main").Cells(i, "A").Value賦值給一個字符串變量並在代碼中使用該變量。我相信每次參考Sheets("Main").Cells(i, "A").Value時，引擎都會通過「工作簿」 - >「表格 - >單元格 - >值」路徑。我不知道優化器有多好。

Dim sValue as String: sValue = Sheets("Main").Cells(i, "A").Value
當你格式化 - 使用With，讓你加快參考：

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

來源

2014-06-25 09:13:39 Juliusz

嗨。與真的加快參考，性能明智？我認爲這只是一種編碼方式？ – VBlades

它曾經在VB6中 - 這就是我所確定的。它在Excel 2013中有幫助嗎？我會檢查它:) – Juliusz

嗨，當使用'with'語句，然後格式需要錯誤'結束語句出現'。有任何解決這個問題的方法嗎？ – sim08

至於評論，試試這個：

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。我評論過重要的部分。
如果有什麼不清楚的地方，只是評論一下。

來源

2014-06-25 09:44:42 L42

++ L42對於比賽我總是忘記一個 –

@mehow是的，當我看到你的帖子時，我幾乎刪除了我的答案。我認爲這是一樣的。然後我看到它不是。順便說一下，對於10k行，這段代碼的運行時間少於1秒：D – L42

@ L42/@me how。這些工作完美，謝謝你的信息。我從來沒有真正理解範圍/數組，但是用這些代碼寫出來，對我來說，我可以使用其他模塊更合理。 – sim08

在運行宏之前，從Excel表格中刪除空行。你可以通過Cntrl + End找到空行。按control +結束，刪除空行並保存您的工作表，然後運行宏。這將幫助你快速運行你的宏，以及減小尺寸，

來源

2014-06-25 12:17:43 user3708287

特定的宏運行更快

回答

相關問題