Включение петли листа

Question

Привет, у меня есть этот код, который работает только на одном листе (sheet3), но я хочу, чтобы он перебирал другие листы книги и запускал этот код. Я пробовал использовать для каждого цикла, но он, похоже, не совместим с этим кодом. Ive искал другие методы петли, но я действительно не уверен, как мне это заняться.

Вот код

Sub DeleteCells() 
    Dim rng As Range, rngError As Range, delRange As Range 
    Dim i As Long, j As Long 

    On Error Resume Next 
    Set rng = Application.InputBox("Select cells To be deleted", Type:=8) 
    On Error GoTo 0 

    If rng Is Nothing Then Exit Sub Else rng.Delete 

    With Sheets("Sheet3") 
     For i = 1 To 7 '<~~ Loop trough columns A to G 
      '~~> Check if that column has any errors 
      On Error Resume Next 
      Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors) 
      On Error GoTo 0 

      If Not rngError Is Nothing Then 
       For j = 1 To 100 '<~~ Loop Through rows 1 to 100 
        If .Cells(j, i).Text = "#REF!" Then 
         '~~> Store The range to be deleted 
         If delRange Is Nothing Then 
          Set delRange = .Columns(i) 
          Exit For 
         Else 
          Set delRange = Union(delRange, .Columns(i)) 
         End If 
        End If 
       Next 
      End If 
     Next 
    End With 

    '~~> Delete the range in one go 
    If Not delRange Is Nothing Then delRange.Delete 
End Sub 

Answer 1

Обычно вы можете петлю через листы, используя их индекс #, или упомянутый для каждого ... Так добавили в код это будет означать:

Sub DeleteCells() 

Dim rng As Range, rngError As Range, delRange As Range 
Dim i As Long, j As Long, k as long 
Dim wks as Worksheet 

On Error Resume Next 

Set rng = Application.InputBox("Select cells To be deleted", Type:=8) 

On Error GoTo 0 

If rng Is Nothing Then Exit Sub Else rng.Delete 

for k = 1 to thisworkbook.worksheets.count 'runs through all worksheets 

    set wks=thisworkbook.worksheets(k) 

    With wks 

    For i = 1 To 7 '<~~ Loop trough columns A to G 

     '~~> Check if that column has any errors 
     On Error Resume Next 

     Set rngError = .Columns(i).SpecialCells(xlCellTypeFormulas, xlErrors) 

     On Error GoTo 0 

     If Not rngError Is Nothing Then 
      For j = 1 To 100 '<~~ Loop Through rows 1 to 100 
       If .Cells(j, i).Text = "#REF!" Then 
        '~~> Store The range to be deleted 
        If delRange Is Nothing Then 
         Set delRange = .Columns(i) 
         Exit For 
        Else 
         Set delRange = Union(delRange, .Columns(i)) 
        End If 
       End If 
      Next j 
     End If 

    Next i 

    End With 

next k 

'~~> Delete the range in one go 
If Not delRange Is Nothing Then delRange.Delete 

End Sub 

Обычно также лучше называть «следующий», потому что у вас есть лучший обзор, который для следующего цикла закрыт.