直到结束

Question

Data to Filter

嗨，

我创建链接到一个脚本宏文件复制AutoFiltered数据环路。我希望它从第一个会计年度过滤财务年度列，并将其复制到另一个表格，然后循环直到处理完所有会计年度。

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

如何过滤可用会计年度的标准，并且会循环直至结束？我的问题是下面的代码，因为它只指定一个会计年度。

ActiveSheet.Range（ “$ A $ 1：$ d $ 20”），自动筛选字段：= 3，标准1：= “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