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

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

2 个答案: