复制AutoFiltered数据循环直到结束

Question

数据过滤

嗨,

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

我在模块中做了重复的操作，但是如果我删除一个财政年度的一个，它将不会继续。

如何用可用的财政年度过滤这些标准，它将一直循环到最后？我的问题是下面的代码，因为它只指定一个财政年度。

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