复制自动过滤的数据循环直到结束

Question

Data to Filter

嗨，

我创建了一个链接到脚本的宏文件。我希望它从第一个财政年度过滤财政年度列并将其复制到另一个工作表，然后循环它直到所有财政年度都已处理完毕。

我在模块中进行了重复操作，但如果我删除了一个会计年度，它将不会继续。

如何使用可用的会计年度过滤条件，它会循环到最后？我的问题是下面的代码，因为它只指定一个会计年度。

ActiveSheet.Range("$A$1:$D$20").AutoFilter Field:=3, Criteria1:="2012"

谢谢！

Answer 1

下面的代码将帮助您遍历年份过滤器。

Option Explicit

Sub Loop_FiscalYear()

Dim Sht                     As Worksheet
Dim Year_Loop               As Integer
Dim Year_Start              As Integer
Dim Year_Finish             As Integer

' modify Sheet1 to your sheet name
Set Sht = ThisWorkbook.Sheets("Sheet1")

' modify these parameters according to your needs
Year_Start = 2012
Year_Finish = 2016

For Year_Loop = Year_Start To Year_Finish
    Sht.Range("$A$1:$D$20").AutoFilter Field:=3, Criteria1:=Year_Loop

    ' do your other stuff here.....

Next Year_Loop

End Sub

编辑 1：选项代码编号 2，计算每个过滤年份的可见行数

Sub Loop_FiscalYear()

Dim Sht                     As Worksheet
Dim Data_Rng                As Range
Dim Year_Loop               As Integer
Dim Year_Start              As Integer
Dim Year_Finish             As Integer
Dim VisibleRows             As Long
Dim Last_Row                As Long
Dim Last_Col                As Long
Dim RngArea

' modify Sheet1 to your sheet name
Set Sht = ThisWorkbook.Sheets("Sheet5") ' ("Sheet1")

' remove all filters from table's data
Sht.Range("C1").Select

If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
End If

' find last row in sheet
Last_Row = Cells(Rows.Count, "A").End(xlUp).row

' find last column in sheet
Last_Col = Cells(1, Columns.Count).End(xlToLeft).Column

Set Data_Rng = Sht.Range(Cells(1, 1), Cells(Last_Row, Last_Col))

' modify these parameters according to your needs
Year_Start = 2012
Year_Finish = 2016

For Year_Loop = Year_Start To Year_Finish

    With Data_Rng
        .AutoFilter Field:=3, Criteria1:=Year_Loop
        .Select

        ' count number of rows in Filtered area
        For Each RngArea In .SpecialCells(xlCellTypeVisible).Areas
            VisibleRows = VisibleRows + RngArea.Rows.Count
        Next

        ' MsgBox just for easy debug
        MsgBox "Autofilter " & VisibleRows - 1 & " rows "

        If VisibleRows = 0 Then
            ' do something...

        End If
    End With

    ' reset value for Next year loop
    VisibleRows = 0

Next Year_Loop

End Sub