循環瀏覽工作表以刪除某些單元格

Question

我希望從工作簿的工作表中刪除特定的單元格。 這樣做時，還應刪除工作簿的這些工作表中具有公式錯誤的特定單元格。 我使用@Blind Seer在stackoverflow中使用的最新程序，按照以下鏈接進行，該鏈接適用於類似的應用程序。

結合片環

程序運行之前的工作簿工作表樣本附在下面

我采用的代碼如下。

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 = "#DIV/0!" 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

運行代碼后，它將刪除輸入框中的單元格輸入，即，將單元格中的數據清空，並將其余數據追加到最后填充的行末尾的行中。 它不會清除錯誤單元格，並且程序會給出錯誤消息：方法'object_Global的聯合失敗

在以下代碼行上

'設置delRange = Union（delRange，.Columns（i））'

試運行后的樣本數據如下。

請幫助找出程序中的錯誤。 所需結果是輸入單元格范圍應空白以保留其行位置。 對於錯誤單元格也是如此。

謝謝

Answer 1

Option Explicit

Sub DeleteCells()
    Dim ws As Worksheet, rng As Range, rngErr As Range

    On Error Resume Next

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

    If Not rng Is Nothing Then
        rng.Delete
        For Each ws In ThisWorkbook.Worksheets
            Set rngErr = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
            If Not rngErr Is Nothing Then rngErr.Clear
        Next
    End If
End Sub

Answer 2

解決方案不多，但出現錯誤的原因是，Union無法跨工作表工作。 適用於單張紙上的范圍。

您可以修改代碼以一次處理一張紙：

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
  With  ThisWorkbook.Worksheets(k)  '<<do each sheet individually so that Union functions as expected  

    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 = "#DIV/0!" 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

Answer 3

您可以使用IsNumeric檢查單元格是否包含數字值。 錯誤不是數值，所以IsNumeric（有錯誤的單元格）= False。 我修改了您的代碼：

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 Not IsNumeric(.Cells(j, i)) 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

注意：這意味着，如果有時要輸入文本，它將被視為錯誤。 因此，請小心！

另外，根據我的評論； 如果您的單元格是其他單元格上的單元格的商，請考慮使用此替代代碼。 support.microsoft.com/en-us/kb/182188。 簡單地跳過除法。