结合表循环

时间:2015-08-17 06:55:40

标签: excel vba excel-vba

您好,我有这个代码只能在一张工作表(sheet3)上运行,但我希望它循环遍历工作簿的其他工作表并运行此代码。我尝试使用for each循环但它似乎与此代码不兼容。我已经查找了其他循环方法,但我真的不确定我该怎么做。

这是代码

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

1 个答案:

答案 0 :(得分:0)

通常你可以使用他们的索引#或每个提到的索引来遍历工作表...所以添加到你的代码中这意味着:

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

通常最好将“下一个”命名为“下一个”,因为您可以更好地了解下一个循环的关闭。