如何循环遍历多个自动筛选条件

时间:2017-08-24 15:03:42

标签: excel-vba vba excel

我正在尝试为自动过滤条件字段创建循环。 Criteria1=07应该转到08,09,10,11,12,然后我希望criteria2增加到2015,criteria1从01到12再开始criteria2到增加到2016年等等。

以下是我的非循环版本的代码:

'07 & 2014
ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=07*", _
    Operator:=xlAnd, Criteria2:="=*2014"
Range([D2], Cells(Rows.Count, "D")).SpecialCells(xlCellTypeVisible)(1).Select
Selection.NumberFormat = "[$-409]mmm-yy;@"
ActiveCell.FormulaR1C1 = "7/1/2014"
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown

'08 & 2014
ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=08*", _
    Operator:=xlAnd, Criteria2:="=*2014"
Range([D2], Cells(Rows.Count, "D")).SpecialCells(xlCellTypeVisible)(1).Select
Selection.NumberFormat = "[$-409]mmm-yy;@"
ActiveCell.FormulaR1C1 = "8/1/2014"
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown

'09 & 2014
ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:="=09*", _
    Operator:=xlAnd, Criteria2:="=*2014"
Range([D2], Cells(Rows.Count, "D")).SpecialCells(xlCellTypeVisible)(1).Select
Selection.NumberFormat = "[$-409]mmm-yy;@"
ActiveCell.FormulaR1C1 = "9/1/2014"
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown

如何使用循环来简化此代码?

1 个答案:

答案 0 :(得分:0)

由于您要运行两组条件,因此需要一个双循环,一个循环在另一个循环中。首先开始循环遍历年份,然后在整个月内循环。然后,您需要克服两个问题,即单个数字月份的前导零和整数到字符串的转换。

这是一个让您入门的示例。请注意,我执行了测试,并建议您使用工作簿的副本,因为Excel中没有撤消宏。

Sub test()
    Dim cr1 As String
    Dim cr2 As String
    Dim j As Integer
    Dim i As Integer

    For j = 2014 To 2017
        For i = 1 To 12
            cr1 = "=" + Format(cr1, "00") + "*"  'Account for leading zero
            cr2 = "=*" + CStr(j)

            ActiveSheet.Range("A:E").AutoFilter Field:=4, Criteria1:=cr1, _
    Operator:=xlAnd, Criteria2:=cr2
            Range([D2], Cells(Rows.Count, "D")).SpecialCells(xlCellTypeVisible)(1).Select
            Selection.NumberFormat = "[$-409]mmm-yy;@"
            ActiveCell.FormulaR1C1 = CStr(i) + "/1/2014"
            Range(Selection, Selection.End(xlDown)).Select
            Selection.FillDown
        Next i
    Next j
End Sub