有没有办法使这一系列自动过滤更加优雅?

时间:2019-01-15 16:22:33

标签: excel vba

我需要完成大量的过滤器,但最终会出现大量的似乎可以被截断的代码块。

如何将所有这些最小化:

        .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

1 个答案:

答案 0 :(得分: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