Kopieren AutoFiltered Datenloop Bis Ende

Question

Data to Filter

Hallo,

ich eine Makrodatei zu einem Skript verknüpft erstellt haben. Ich möchte, dass die Spalte "Geschäftsjahr" aus dem ersten Geschäftsjahr gefiltert und auf ein anderes Blatt kopiert wird, um sie dann zu wiederholen, bis alle Geschäftsjahre verarbeitet wurden.

Ich machte eine repetitive Aktionen im Modul, aber wenn ich eines der Geschäftsjahre entfernen, wird es nicht fortgesetzt.

Wie filtere ich die Kriterien mit den verfügbaren Geschäftsjahren und es wird Schleife bis zum Ende? Mein Problem ist der folgende Code, da nur ein Geschäftsjahr angegeben wird.

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

Thank you!

Answer 1

Der folgende Code hilft Ihnen beim Durchlaufen des Jahresfilters.

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 

Edit 1: Option Code-Nummer 2, zählen Anzahl der sichtbaren Zeilen pro Filtered Jahr

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