Excel VBA - 如果单元格是整数,则删除整行

tra*_*cer 3 excel vba excel-vba delete-row

我一直在尝试使用一些片段来说明如何删除Excel VBA上的整行,但我无法修改它们以包含"IsNumber"验证.

我需要能够选择一个活动区域,例如:

Set r = ActiveSheet.Range("A1:C10")
Run Code Online (Sandbox Code Playgroud)

并且当它经过一行一行(并检查该区域的每个单元格)时,如果单元格上有数字,则删除整行.

例如:

NA NA NA 21
NA 22 NA 44
00 NA NA NA
NA NA NA NA
55 NA NA NA
Run Code Online (Sandbox Code Playgroud)

然后宏将删除所有行,除了第4行

NA NA NA NA
Run Code Online (Sandbox Code Playgroud)

Sid*_*out 5

拿你的选择:)

方式1(经过试验和测试)

这用于SpecialCells标识具有数字的行.

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range

    On Error GoTo Whoa

    Set ws = Sheets("Sheet1")

    With ws
        Set rng = .Cells.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow

        rng.ClearContents '<~~ or rng.Clear if cells have formatting

        .Cells.Sort Key1:=.Range("A1")
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)

方式2(经过试验和测试)

这使用循环并Count()检查数字

Sub Sample()
    Dim ws As Worksheet
    Dim delrange As Range
    Dim lRow As Long, i As Long

    On Error GoTo Whoa

    Set ws = Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow
            If Application.WorksheetFunction.Count(.Rows(i)) > 0 Then
                If delrange Is Nothing Then
                    Set delrange = .Rows(i)
                Else
                    Set delrange = Union(delrange, .Rows(i))
                End If
            End If
        Next i

        If Not delrange Is Nothing Then delrange.Delete
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)

方式3(经过试验和测试)

这使用自动过滤器.我假设第1行有标题,你的范围内没有空白单元格.

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, lCol As Long, i As Long
    Dim ColN As String

    On Error GoTo Whoa

    Set ws = Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For i = 1 To lCol
            '~~> Remove any filters
            .AutoFilterMode = False
            ColN = Split(.Cells(, i).Address, "$")(1)

            '~~> Filter, offset(to exclude headers) and delete visible rows
            With .Range(ColN & "1:" & ColN & lRow)

                .AutoFilter Field:=1, Criteria1:=">=" & _
                Application.WorksheetFunction.Min(ws.Columns(i)), _
                Operator:=xlOr, Criteria2:="<=" & _
                Application.WorksheetFunction.Max(ws.Columns(i))

                .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End With

            '~~> Remove any filters
            .AutoFilterMode = False
        Next
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)