我可以缩短代码执行时间吗？

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()方法将其降为零。