Отфильтруйте и удалите критерии, которые я отфильтровал из другого столбца.

Question

все. Я новичок в языке VBA. Исходя из моей ситуации,

1) Я хотел бы отфильтровать «невыполненные» из столбца H и удалить его

2) Я хотел бы отфильтровать «Y» из столбца Q и удалить его

Я написал код для его запуска. Когда я нажимаю Run в первый раз, я могу отфильтровать и удалить первое требование, но если я хочу отфильтровать и удалить второе требование, мне нужно снова нажать Run. Могу ли я знать, как выполнить это требование один раз. В приложении ниже мой код

Sub try2()
Dim Filterrng1 As Range, Filterrng2 As Range
Dim Delrng1 As Range, Delrng2 As Range
Dim FilterArr1
Dim FilterArr2

Application.ScreenUpdating = False

FilterArr1 = Array("Unfulfilled")
FilterArr2 = Array("Y")

Set Filterrng1 = Range("H1", Range("H" & Rows.Count).End(xlUp))
Set Filterrng2 = Range("Q1", Range("Q" & Rows.Count).End(xlUp))

Set Delrng1 = Filterrng1.Offset(1, 0)
Set Delrng2 = Filterrng2.Offset(1, 0)

Debug.Print LBound(FilterArr1)
Debug.Print LBound(FilterArr2)

For f = LBound(FilterArr1) To UBound(FilterArr1)

    Filterrng1.AutoFilter Field:=1, Criteria1:="=" & FilterArr1(f)

    If Filterrng1.SpecialCells(xlCellTypeVisible).Count > 1 Then
        Delrng1.EntireRow.Delete
    End If


    For a = LBound(FilterArr2) To UBound(FilterArr2)

        Filterrng2.AutoFilter Field:=1, Criteria1:="=" & FilterArr2(a)

        If Filterrng2.SpecialCells(xlCellTypeVisible).Count > 1 Then
            Delrng2.EntireRow.Delete
        End If
    Next
Next



Filterrng1.AutoFilter 'Remove Autofilter from range
Filterrng2.AutoFilter 'Remove Autofilter from range
End Sub

Answer 1

sub try3()

Dim rg As Range

Set rg = ActiveSheet.Range("H1").CurrentRegion     'Edit to your range

Dim Filterrng1 As Range, Filterrng2 As Range

Dim Delrng1 As Range, Delrng2 As Range

Dim FilterArr1

Dim FilterArr2

Set Filterrng1 = Range("H1", Range("H" & Rows.Count).End(xlUp))

Set Filterrng2 = Range("Q1", Range("Q" & Rows.Count).End(xlUp))

Set Delrng1 = Filterrng1.Offset(1, 0)

Set Delrng2 = Filterrng2.Offset(1, 0)

rg.AutoFilter Field:=1, Criteria1:="Unfulfilled"

If Filterrng1.SpecialCells(xlCellTypeVisible).Count > 1 Then

    Delrng1.EntireRow.Delete

End If

rg.AutoFilter

rg.AutoFilter Field:=10, Criteria1:="Y"

If Filterrng2.SpecialCells(xlCellTypeVisible).Count > 1 Then

    Delrng2.EntireRow.Delete

End If

end sub

Добавьте другие вещи, такие как screenupdating, et c.