Есть ли способ сделать эту серию автофильтров более элегантной?

Question

У меня есть тонна фильтров, которые мне нужно выполнить, но в итоге получается огромное количество блоков кода, которые, похоже, могут быть усечены.

Как я могу минимизировать все это:

        .Cells.AutoFilter Field:=5, Criteria1:="xxxxxx"
        .Range(Cells(2, 5), Cells(lr, 5)).SpecialCells(xlCellTypeVisible).Value = .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible)
        .Cells.Autofiler

        .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx"
        .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "FULL ACCOUNT UPGRADE"
        .Cells.AutoFilter
        .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx"
        .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "LIGHT ACCOUNT ESTABLISHED"
        .Cells.AutoFilter

            .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx", Criteria2:="xxxxxx2"
            .Cells.AutoFilter Field:=27, Criteria1:="YES"
            .Cells.AutoFilter Field:=17, Criteria1:="Public"
            .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "LIGHT ACCOUNT ESTABLISHED"
            .Cells.AutoFilter

                .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx", Criteria2:="Light Enablement through Payment Proposal"
                .Cells.AutoFilter Field:=27, Criteria1:="YES"
                .Cells.AutoFilter Field:=17, Criteria1:="Private"
                .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "ACTIVATED FOR AFTER FULL USE TRR WAS SENT/ACCEPTED"
                .Cells.AutoFilter

                    .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx", Criteria2:="xxxxxx2"
                    .Cells.AutoFilter Field:=27, Criteria1:="NO"
                    .Cells.AutoFilter Field:=17, Criteria1:="Private"
                    .Cells.AutoFilter Field:=66, Criteria1:="YES"
                    .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "ACTIVATED FOR -- PO SENT BUT NOT RESPONDED TO"
                    .Cells.AutoFilter
                    .Cells.AutoFilter Field:=18, Criteria1:="xxxxxx", Criteria2:="xxxxxx2"
                    .Cells.AutoFilter Field:=27, Criteria1:="NO"
                    .Cells.AutoFilter Field:=17, Criteria1:="Private"
                    .Cells.AutoFilter Field:=66, Criteria1:="NO"
                    .Range(Cells(2, 3), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Value = "ACTIVATED FOR -- PO NOT SENT"
                    .Cells.AutoFilter

Answer 1

Создайте новую подпрограмму или функцию, используя только три строки, которые повторяются в текущем коде. Определите параметры для вещей, которые меняются. Затем вызовите подпрограмму / функцию для каждого набора параметров. Что-то вроде

'call the sub/function from other code
DoAutoFilterArray ws, 5, "xxxxxx", Cells(2, 5), Cells(lr, 5), Cells(2, 3), Cells(lr, 3)
DoAutoFilterString ws, 18, "xxxxxx", Cells(2, 3), Cells(lr, 3), "FULL ACCOUNT UPGRADE"

Sub DoAutoFilterArray(ws as Worksheet, filterField as Long, criteria as String, _
                 sourceCell1 as Range, sourceCell2 as Range, _
                 targetCell1 as Range, targetCell2 as Range)

  With ws
    .Cells.AutoFilter Field:=filterField, Criteria1:=criteria
    .Range(sourceCell1, sourceCell2).SpecialCells(xlCellTypeVisible).Value = .Range(targetCell1, targetCell2).SpecialCells(xlCellTypeVisible)
    .Cells.Autofiler
  End With
End Sub

Sub DoAutoFilterString(ws as Worksheet, filterField as Long, criteria as String, _
                 sourceCell1 as Range, sourceCell2 as Range, _
                 targetValue as String)

  With ws
    .Cells.AutoFilter Field:=filterField, Criteria1:=criteria
    .Range(sourceCell1, sourceCell2).SpecialCells(xlCellTypeVisible).Value = targetValue
    .Cells.Autofiler
  End With
End Sub