我可以縮短代碼執行時間嗎？

Question

此代碼需要超過10秒才能完成。有沒有更快的方法來做到這一點？

如果連續特定小區由「H」字則隱藏整個行，這裏也有一個給定的背景顏色解釋單元格的內容，它的指數代碼爲19。

Option Explicit 

Sub TailoredInputs() 
Dim ws As Worksheet 
Dim i, j, l As Integer 

Set ws = Sheets("Inputs") 
Application.ScreenUpdating = False 

Range("A7:A200").EntireRow.Hidden = False 

With ws 
    .Select 
    j = 10 

    Do While j <= 149 

     If .Cells(j, "J").Value = "H" Then 
      For l = 4 To 9 
       If .Cells(j, l).Interior.ColorIndex = 19 Then 
        .Cells(j, l).ClearContents 
       Else: End If 
      Next l 

      .Cells(j, "J").EntireRow.Hidden = True 

     Else: End If 

     If .Cells(j, "K").Value = "H" Then 
      For l = 4 To 9 
       If .Cells(j, l).Interior.ColorIndex = 19 Then 
        .Cells(j, l).ClearContents 
       Else: End If 
      Next l 

      .Cells(j, "J").EntireRow.Hidden = True 

     Else: End If 

     j = j + 1 
    Loop 

    Range("Spendinginput").Select 

End With 

Application.ScreenUpdating = True 
End Sub 

Answer 1

未經測試：

Sub TailoredInputs() 
    Dim ws As Worksheet 
    Dim i, j, l As Integer, rngHide As Range 

    Set ws = Sheets("Inputs") 
    Application.ScreenUpdating = False 

    ws.Range("A7:A200").EntireRow.Hidden = False 

    For j = 10 To 149 
     If ws.Cells(j, "J").Value = "H" Or ws.Cells(j, "K").Value = "H" Then 
      For l = 4 To 9 
       If ws.Cells(j, l).Interior.ColorIndex = 19 Then 
        ws.Cells(j, l).ClearContents 
       End If 
      Next l 
      'build the range which will be hidden 
      If rngHide Is Nothing Then 
       Set rngHide = ws.Cells(j, 1) 
      Else 
       Set rngHide = Application.Union(rngHide, ws.Cells(j, 1)) 
      End If 

     End If 
    Next j 

    'anything to hide? Hide it. 
    If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True 

    ws.Range("Spendinginput").Select 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

我要看的第一件事就是擺脫10到149行的顯式循環。

您可以改爲使用Range.Find方法在您感興趣的範圍內找到包含H的第一個單元格。與所有潛在的優化一樣，您應該檢查它，但我會想象Excel搜索對於下面的值可能比手動檢查每個單元格更快。

例如，考慮下面的代碼：

Option Explicit 
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll"() As Long 

Sub Macro1() 
    Dim ws As Worksheet 
    Dim j As Integer 
    Dim t As Long 
    Dim x As Range 

    If False Then ' or use true for explicit loop ' 
     t = GetTickCount 
     j = 1 
     Do While j <= 9999 
      If Worksheets(1).Cells(j, 1).Value = "H" Then 
       MsgBox ("found it " & j & " " & (GetTickCount - t)) 
       j = 10000 
      End If 
      j = j + 1 
     Loop 
    Else 
     t = GetTickCount 
     Set x = Range("A1:A9999").Find("H") 
     MsgBox ("found it " & x.Row & " " & (GetTickCount - t)) 
    End If 
End Sub 

隨着在if聲明（顯式循環）true與只不過是H細胞A9999工作表，大約需要46毫秒，找到價值。使用Range.Find()方法將其降爲零。