Могу ли я сократить время выполнения этого кода?

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 

С true в if операторов (явного цикла) и рабочий лист с ничего, кроме H в клетке A9999, она занимает около 46 миллисекунд, чтобы найти значение. Использование метода Range.Find() падает до нуля.