Question

Data to Filter

您好，

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

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

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

ActiveSheet.Range（＆＃34; $ A $ 1：$ D $ 20＆＃34;）。AutoFilter字段：= 3，Criteria1：=＆＃34; 2012＆＃34;

谢谢！

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

复制自动筛选数据循环直到结束

1 个答案: