Excel VBA - если ячейка является целым числом, удалите всю строку

Я пытался использовать некоторые фрагменты о том, как удалить целые строки в Excel VBA, но я не могу изменить их, чтобы включить проверку "IsNumber".

Мне нужно иметь возможность выбрать активную область, например: 

Set r = ActiveSheet.Range("A1:C10")

И по мере прохождения строки за строкой (и проверки каждой ячейки области) удалите всю строку, если на ячейке есть число.

Например: 

NA NA NA 21
NA 22 NA 44
00 NA NA NA
NA NA NA NA
55 NA NA NA

Затем макрос удалит все строки, за исключением 4-й, которая является 

NA NA NA NA
3 3
excel vba excel-vba delete-row

3 ответа:

Выбирайте сами:)

СПОСОБ 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

СПОСОБ 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

Способ 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
5
Sub DeleteNumeric()

    Dim i As Long
    Dim rCell As Range
    Dim rRow As Range
    Dim rRng As Range

    'identify the range to search
    Set rRng = Sheet1.Range("A1:D5")

    'loop backwards when deleting rows
    For i = rRng.Rows.Count To 1 Step -1
        'loop through all the cells in the row
        For Each rCell In rRng.Rows(i).Cells
            If IsNumeric(rCell.Value) Then
                'delete the row and go to the next one
                rCell.EntireRow.Delete
                Exit For
            End If
        Next rCell
    Next i

End Sub
1
Dim currentPos As Integer

currentPos = 1

Do While (currentPos < yourNumberofRow)
If (Range("A" & currentPos).Value.IsNumeric = True) Then
    Rows(currentPos & ":" & currentPos).Select
    Selection.Delete
End If

currentPos = currentPos +1
Loop

Не попробовать, но простой код, чтобы понять, удалить и числового теста.

0