Autofilter via VBA

Horst · 1970-01-01T00:00:00+00:00

Hallo Excel-Freaks! Aus einer Tabelle, in der in Spalte A und B Einsen und Nullen stehen (in Spalte C bis Z stehen Gleitkommazahlen) soll mittels VBA-Code ein neues Sheet erstellt werden, in dem sämtliche Zeilen von Spalte A mit Wert "1", und auf einen neuen Sheet sämtliche Zeilen von Spalte B mit Wert "1" zusammengefasst werden. Bei Erstellung der neuen sheets sollen ältere sheets überschrieben, d.h. gelöscht werden. Wer kann diese automatisierte Autofilter-Funktion elegant lösen? Besten Dank vorab!

Hallo Horst,
Hier mal eine angepasste Fassung inkl. Speichern des Tabellenblatts im Textformat. Gewünschtes Format muss du durch Anpassung der als Kommentar schon eingefügten Zeilen noch festlegen.
Beim Start des Makros muss das tabellenblatt mit den zu filternden Daten aktiv sein.
Gruß
Franz

Sub ExportSpalteFilter()
Dim wks As Worksheet, wksResult As Worksheet, LastRow As Long
Dim vAuswahl As Variant, wbResult As Workbook, sDatei As String
On Error GoTo Fehler
Set wks = ActiveSheet
Set wksResult = Sheets("result")
With wksResult
.UsedRange.ClearContents
End With
With wks
If .FilterMode = True Then
If .Rows.Count  _
Cells.SpecialCells(xlCellTypeVisible).EntireRow.Rows.Count Then
.ShowAllData
End If
End If
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
End With
Cells(1, 1).Select
Selection.AutoFilter Field:=3, Criteria1:="1"
wks.Range("AQ1:CD" & LastRow).Copy Destination:=wksResult.Cells(1, 1)
ActiveWorkbook.Save
wksResult.Activate
'Dateinamen für Exportdatei wählen
vAuswahl = Application.GetSaveAsFilename(InitialFileName:="TextExport.Txt", _
FileFilter:="Text(*.txt),*.txt", _
Title:="Bitte Dateinamen für Text-Export-Datei auswählen/eingeben")
If vAuswahl  False Then
'Dateinamen merken
sDatei = ActiveWorkbook.FullName
Set wbResult = ActiveWorkbook
'Aktives Tabellenblatt als Textdatei speichern
'xlUnicodeText
wbResult.SaveAs Filename:=vAuswahl, FileFormat:=42
'xlUnicodeText mit lokalen Einstellungen für Dezimalzeichen und Trennzeichen
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=42, Local:=True
'xlTextMSDOS MSDOS-Text
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=21
'xlTextPrinter Druckertext (Zwischen Spalten werden Leerzeichen eingefügt, _
Zeichenzahl pro Zeile ist begrenzt
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=36
'xlTextWindows Windows Text
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=20
'xlCSV CSV-Format - mit US-Einstellungen für Dezimal- und Trennzeichen
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=6, Local:=False
'xlCSV CSV-Format mit lokalen Einstellungen für Dezimalzeichen und Trennzeichen
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=6, Local:=True
'xlCSVWindows CSV(Windows)
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=23
'xlCSVWindows CSV(Windows) mit lokalen Einstellungen für Dezimalzeichen _
und Trennzeichen
'    wbResult.SaveAs Filename:=vAuswahl, FileFormat:=23, Local:=True
Workbooks.Open Filename:=sDatei
wbResult.Close savechanges:=False
End If
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End Select
End With
End Sub

Hallo Horst,
zur Autofilter-Frage:
Wird den der Filter vom Makro in der richtigen Spalte gesetzt?
Makro in Datei A.xls, Daten in B.xls
Dann muss das Makro etwa wie folgt aussehen.

Sub ExportSpalteFilter()
Dim wks As Worksheet, wksResult As Worksheet, LastRow As Long, wbDaten As Workbook
Dim vAuswahl As Variant, wbResult As Workbook, sDatei As String
On Error GoTo Fehler
Set wbDaten = Workbooks("TextExport02.xls") '                            Dateiname anpaasen!!! _
Set wks = wbDaten.Worksheets(1) ' oder  auch wbDaten.worksheets("TabelleABC")
Set wksResult = ThisWorkbook.Sheets("result") 'sollte dann in der Datei mit dem Makro sein
With wksResult
'.UsedRange.ClearContents  'Warum sollen ggf. vorhandene Altdaten nicht gelöscht werden?
End With
wbDaten.Activate
wks.Activate
With wks
If .FilterMode = True Then
If .Rows.Count  _
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Rows.Count Then
.ShowAllData
End If
End If
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
End With
wks.Cells(1, 1).Select
Selection.AutoFilter Field:=1, Criteria1:="1"
wks.Range("AQ1:CD" & LastRow).Copy Destination:=wksResult.Cells(1, 1)
wbDaten.Save
ThisWorkbook.Activate
wksResult.Activate
ThisWorkbook.Save
'Dateinamen für Exportdatei fixieren
vAuswahl = "C:\Dokumente und Einstellungen\User\Desktop\TextExport.Txt"
vAuswahl = "C:\Users\Public\Test\TextExport.Txt"
Set wbResult = ActiveWorkbook
sDatei = ThisWorkbook.FullName
'Aktives Tabellenblatt als Textdatei speichern
'xlUnicodeText
wbResult.SaveAs Filename:=vAuswahl, FileFormat:=42
Workbooks.Open Filename:=sDatei
wbResult.Close savechanges:=False
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End Select
End With
End Sub

Pivot-Tabellen:
Du kannst, wenn die Spaltentitel in Zeile 1 stehen aiúch die kompletten Spalten als Datenquelle vorgeben.
Dann muss du ggf. im Pivotbericht für ein Feld den Filter so einstellen, dass (Leer) nicht angezeigt wird.
Außerdem solltest du unter den Tabellenoptionen der Pivot-Tabelle die Option "Quelldaten mit Datei speichern" deaktivieren, da sonst die Dateigröße nach oben schnellt.
Ein Tabellenblatt mit Pivottabellenbericht kannst du als Textdatei speichern, aber das Ergebnis entspricht dann evtl. nicht deinen Wünschen. Hier solltest du als Alternative ggf. wirklich meinen ursprünglichen Vorschlag aufgreifen und mit einem per MS-Query erstellten Datenimport arbeiten. Ganz speziell, wenn du die Daten aus einer externen Exceltabelle übernehmen möchtest.
Gruß
Franz

Forumthread: Autofilter via VBA

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Autofilter mit VBA in Excel verwenden

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)