删除自定义组中的单元格，而不是整行或整列

Question

我有这个代码可以删除整列的单元格。最初我认为它会很好用，后来我意识到如果我这样做，同一列上的有用数据也会被删除。因此，我需要一个代码，它允许我在自己方便的时候删除任何范围的单元格，无论是行还是列

Sub TestDatabase()

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

Answer 1

我认为为了满足您的需求，您只需删除 .Columns() 方法即可。这反过来又带来了新的问题——当你删除一个单元格时，Excel应该以哪种方式移动剩余的单元格？

你可以试试这样的：

If .Cells(j, i).Text = "#REF!" Then
    '~~> Store The range to be deleted
    If delRange Is Nothing Then
        Set delRange = .Cells(j, i)
        '// Exit For <~~ This stops your code adding any more cells to delRange
    Else
        Set delRange = Union(delRange, .Cells(j, i))
    End If
End If

然后当你删除时：

'// Could use xlUp, xlDown, xlToRight or xlToLeft
delRange.delete shift:=xlUp

值得注意的是，由于delRange现在指向一组单元格，可以删除：

• 仅单元格，使用上述方法。
• 属于这些单元格的行使用delRange.EntireRow.Delete shift:=xlUp
• 或属于这些单元格的列，使用delRange.EntireColumn.Delete shift:=xlToLeft

Answer 2

虽然我仍然不清楚您的最终目的，但删除任何大小或形状范围都相当简单。就像清除（或删除）所有 #REF! 错误一样。

我建议您选择Peter Thornton's GetInputRange function，它可以解决您使用InputBox 从用户那里获取范围时可能遇到的任何潜在问题。

Option Explicit

Sub Test()
    Dim targetArea As Range
    Dim success As Boolean

    '--- clears only the contents from the currently selected area
    Set targetArea = Application.Selection
    targetArea.ClearContents
    '--- optionally delete the area, but this shifts all the other data into the area
    'targetArea.Delete Shift:=xlShiftUp
    ClearAllRefErrors

    '--- asks for the area to be cleared
    '    uses Peter Thornton's GetInputRange method (http://www.jkp-ads.com/Articles/SelectARange.asp)
    success = GetInputRange(targetArea, "Enter the range to delete:", "Delete Range", _
                           Application.Selection.Address)
    If success Then
        targetArea.ClearContents
        '--- optionally delete the area, but this shifts all the other data into the area
        'targetArea.Delete Shift:=xlShiftUp
        ClearAllRefErrors
    End If
End Sub

Sub ClearAllRefErrors()
    Dim ws As Worksheet
    Dim rangeInUse As Range
    Dim rangeCell As Range

    For Each ws In ThisWorkbook.Sheets
        Set rangeInUse = Application.ActiveSheet.usedRange
        For Each rangeCell In rangeInUse
            If rangeCell = CVErr(xlErrRef) Then
                rangeCell.ClearContents
                '--- optionally delete the cell, but this shifts all the other data
                'rangeCell.Delete Shift:=xlShiftUp
            End If
        Next rangeCell
    Next ws
End Sub