Я использую простой код ниже, чтобы удалить ненужные строки. Это работает очень хорошо, но я не могу избежать удаления первой строки, независимо от того, соответствует ли она критерию удаления. Есть вопрос без ответа, нужно попробовать кое-что (я пробовал), но нет решения, поэтому я думаю, что успех в моем вопросе поможет и другим.
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
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Возможно, потребуется обернуть это в On Error Resume Next
и On Error Goto 0
, чтобы обработать случай, когда нет видимых строк.
Это должно сделать это:
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
Первое предложение скрыло данные, а второе удалило все. Спасибо, в любом случае