0

オートフィルターを使用して基準に基づいて行を削除しようとしています..作業中のワークシートには多くのデータがあるためです。以下に示すように、必要な基準に合うように編集したこのサイトのコードを見つけました。コードはエラーなしで実行されますが、行は削除されません! どんな助けでも大歓迎です!基準を見つけたい列は列Bです。

Private Sub CommandButton2_Click()
Dim rngTable As Range
Dim ws As Worksheet
Dim StartCell As Range

Const ColumntoFilter1 As Integer = 2
Const FilterCriteria1 As String = "Amended Holiday"
Const ColumntoFilter2 As Integer = 2
Const FilterCriteria2 As String = "Designated Holiday"
Const ColumntoFilter3 As Integer = 2
Const FilterCriteria3 As String = "Max Sick Hours"
Const ColumntoFilter4 As Integer = 2
Const FilterCriteria4 As String = "Leave Without Pay 02"
Const ColumntoFilter5 As Integer = 2
Const FilterCriteria5 As String = "Holiday Accrued"
Const ColumntoFilter6 As Integer = 2
Const FilterCriteria6 As String = "Leave Without Pay 03"
Const ColumntoFilter7 As Integer = 2
Const FilterCriteria7 As String = "Max Holiday Hours"
Const ColumntoFilter8 As Integer = 2
Const FilterCriteria8 As String = "Leave Without Pay 04"
Const ColumntoFilter9 As Integer = 2
Const FilterCriteria9 As String = "Sick Accrued"

Set ws = ActiveSheet
'Set the starting position (Top-left most position) of your data range
Set StartCell = ws.Range("B1")

'Turn off autofilter in case it's already active
ws.AutoFilterMode = False
   'Define data table
    Set rngTable = StartCell.CurrentRegion
    'Filter and delete data
    With rngTable
    .AutoFilter Field:=ColumntoFilter1, Criteria1:=FilterCriteria1
    .AutoFilter Field:=ColumntoFilter2, Criteria1:=FilterCriteria2
    .AutoFilter Field:=ColumntoFilter3, Criteria1:=FilterCriteria3
    .AutoFilter Field:=ColumntoFilter4, Criteria1:=FilterCriteria4
    .AutoFilter Field:=ColumntoFilter5, Criteria1:=FilterCriteria5
    .AutoFilter Field:=ColumntoFilter6, Criteria1:=FilterCriteria6
    .AutoFilter Field:=ColumntoFilter7, Criteria1:=FilterCriteria7
    .AutoFilter Field:=ColumntoFilter8, Criteria1:=FilterCriteria8
    .AutoFilter Field:=ColumntoFilter9, Criteria1:=FilterCriteria9
    .Offset(1, 0).EntireRow.Delete
End With

'Turn filters off again
ws.AutoFilterMode = False

Set rngTable = Nothing
Set StartCell = Nothing
Set ws = Nothing
End Sub
4

1 に答える 1