Как я могу избежать удаления первой строки в этом простом коде EntireRow.Delete VBA?

Я использую простой код ниже, чтобы удалить ненужные строки. Это работает очень хорошо, но я не могу избежать удаления первой строки, независимо от того, соответствует ли она критерию удаления. Есть вопрос без ответа, нужно попробовать кое-что (я пробовал), но нет решения, поэтому я думаю, что успех в моем вопросе поможет и другим.

Sub DeleteCertainRows()

Dim lr As Long
lr = ActiveSheet.UsedRange.Rows.Count
    With Range("E1:E" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1: = ">2"
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
End Sub

Первое предложение скрыло данные, а второе удалило все. Спасибо, в любом случае

Michelle Trudeau 29.07.2024 23:12
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Возможно, потребуется обернуть это в On Error Resume Next и On Error Goto 0, чтобы обработать случай, когда нет видимых строк.
Tim Williams 29.07.2024 23:16
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
2
2
53
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

Ответ принят как подходящий

Это должно сделать это:

Sub DeleteCertainRows()

    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    With ws.Range("E1:E" & ws.Cells(Rows.Count, "E").End(xlUp).Row)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1: = ">2"
        On Error Resume Next 'in case there are no visible rows...
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error Goto 0      'stop ignoring errors
    End With
End Sub

Ответил Тим Уильямс и разместил здесь, чтобы помочь другим.

On Error Resume Next и On Error Goto 0 в моем случае не понадобились.


Sub DeleteCertainRows()
    
    Dim lr As Long
    lr = ActiveSheet.UsedRange.Rows.Count
    With Range("E1:E" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1: = ">2"
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End Sub

Удалить строки диапазона

Применение

Sub Test()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    DeleteRangeRowsByCriterion rg, 5, ">2", True

End Sub

Вспомогательный метод

Sub DeleteRangeRowsByCriterion( _
        ByVal rg As Range, _
        ByVal Field As Long, _
        ByVal Criteria1 As Variant, _
        Optional ByVal IsInTestMode As Boolean = False)
    Const PROC_TITLE As String = "Delete Range Rows By Criterion"
    On Error GoTo ClearError ' start error-handling routine
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = rg.Worksheet
    
    ' Store the number of data rows in a variable.
    Dim DataRowsCount As Long: DataRowsCount = rg.Rows.Count - 1
    
    ' Validate the number of data rows.
    If DataRowsCount = 0 Then
        MsgBox "The range ""'" & ws.Name & "'!" & rg.Address(0, 0) _
            & """ has only one row!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Validate the column index.
    If Field < 1 Then
        MsgBox "The column index (" & Field & ") is too small!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    If Field > rg.Columns.Count Then
        MsgBox "The column index (" & Field & ") is too big for the range " _
            & """'" & ws.Name & "'!" & rg.Address(0, 0) & """!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Store the AutoFilterMode state in a variable.
    If ws.FilterMode Then ws.ShowAllData ' clear filters
    Dim WasAutoFiltered As Boolean: WasAutoFiltered = ws.AutoFilterMode
    ws.AutoFilterMode = False ' turn off auto-filtering
    
    ' Reference the data range (no headers).
    Dim drg As Range: Set drg = rg.Resize(DataRowsCount).Offset(1)
    Dim drgAddress As String:
    drgAddress = "'" & ws.Name & "'!" & drg.Address(0, 0)
    
    ' Filter the range (has headers).
    rg.AutoFilter Field:=Field, Criteria1:=Criteria1
    
    ' Reference the filtered data rows.
    Dim fdrg As Range:
    On Error Resume Next ' defer error handling (ignore errors)
        Set fdrg = drg.SpecialCells(xlCellTypeVisible)
    On Error GoTo ClearError ' restart error-handling routine
    
    ' Restore AutoFilterMode state.
    If WasAutoFiltered Then
        ws.ShowAllData
    Else
        ws.AutoFilterMode = False
    End If
    
    ' Check if no filtered rows.
    If fdrg Is Nothing Then
        MsgBox "No matching rows found in """ & drgAddress & """!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Store the number of filtered rows in a variable.
    Dim FilteredRowsCount As Long
    FilteredRowsCount = Intersect(fdrg, drg.Columns(1)).Cells.Count
    
    ' Delete or select the filtered rows.
    If IsInTestMode Then
        Application.Goto Reference:=fdrg
    Else
        fdrg.Delete Shift:=xlShiftUp
    End If
    
    ' Inform.
    MsgBox IIf(IsInTestMode, "Running in Test Mode!" & vbLf & vbLf, "") _
        & IIf(IsInTestMode, "Selected", "Deleted") & " " & FilteredRowsCount _
        & " row" & IIf(FilteredRowsCount = 1, "", "s") & " in """ _
        & drgAddress & """!", _
        IIf(IsInTestMode, vbExclamation, vbInformation), PROC_TITLE
        
ProcExit:
    Exit Sub
ClearError: ' continue error-handling routine
    MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub

Другие вопросы по теме