直到結束

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