Makro: nur gefilterte Daten als CSV-Datei speichern

Question

Hallo Zusammen,

das folgende Makro funktioniert super. Ich möchte es allerdings etwas abändern.

In der Ziel-CSV-Datei sollen nur die Daten enthalten sein, wenn in Spalte C "nie dispo 55 60" steht. Alle anderen Daten sollen nicht in der Ziel-CSV-Datei auftauchen.

Kann mir jemand bei der Überarbeitung des bestehenden Makros helfen?

LG, Colatrinker1

Sub Nie_dispo_55und60()
'
' Nie_dispo_55und60 Makro
'
Dim Ausgabepfad As String
Dim Ausgabedatei As String
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim Zeile As String
Dim VollZeile As String
Dim Trennzeichen As String
Dim i As Long
Dim z As Long
Dim d As Long
Dim strBlatt As String

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

'Ausgabepfad wird festgelegt
Ausgabepfad = "\\192.168.50.9\LogoMate_Transfer\LogoMate\Daten\Manuell\Nie dispo 55und60\"

'Trennzeichen wird festgelegt
Trennzeichen = ";"

For d = 1 To 3

Select Case d
Case Is = 1
strBlatt = "Nie dispo 55_60"

End Select

'Ausgabepfad und Dateinamen für Ausgabedatei erstellen
Ausgabedatei = Ausgabepfad & strBlatt & ".csv"

'letzte Zeile des jeweiligen Tabellenblatts ermitteln
lngLetzte = Worksheets(strBlatt).Cells(Rows.Count, 1).End(xlUp).Row

'Falls Ausgabedatei bereits besteht, wird diese gelöscht
If Dir(Ausgabedatei) <> "" Then Kill (Ausgabedatei)

'Datei Öffen zur Ausgabe
Open Ausgabedatei For Output As #1

For z = 1 To lngLetzte

For lngSpalte = 1 To 3
Zeile = Trim(Worksheets(strBlatt).Cells(z, lngSpalte).Text)
Zeile = Replace(Zeile, Trennzeichen, "") 'ggf in Text vorkommendes Trennzeichen wird gelöscht
VollZeile = VollZeile & Zeile & Trennzeichen
Next lngSpalte

'Ausgabe in Datei
VollZeile = Left(VollZeile, Len(VollZeile) - 1) 'Letztes Semicolon abschneiden
If Len(Replace(VollZeile, Trennzeichen, "")) > 0 Then Print #1, VollZeile
VollZeile = ""

Next z

Close #1 'Datei schliessen

Next d

'Bildschirmaktualiserung
Application.ScreenUpdating = True

'Abschlussmeldung
MsgBox "Nie dispo 55und60 als CSV gespeichert", 64
End Sub

Answer 1

Hi,

mal als Tipp: filtere dein Tabellenblatt nach Spalte C, kopiere dann die sichtbaren Zeilen in ein neues Tabellenblatt und speichere dieses dann als CSV-Datei.

Bis später, Karin

Answer 2

Hallo,

du kannst aber auch eine Abfrage einbauen:

Sub Nie_dispo_55und60()
'
' Nie_dispo_55und60 Makro
'
Dim Ausgabepfad As String
Dim Ausgabedatei As String
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim Zeile As String
Dim VollZeile As String
Dim Trennzeichen As String
Dim i As Long
Dim z As Long
Dim d As Long
Dim strBlatt As String

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

'Ausgabepfad wird festgelegt
Ausgabepfad = "\\192.168.50.9\LogoMate_Transfer\LogoMate\Daten\Manuell\Nie dispo 55und60\"

'Trennzeichen wird festgelegt
Trennzeichen = ";"
strBlatt = "Nie dispo 55_60"

'Ausgabepfad und Dateinamen für Ausgabedatei erstellen
Ausgabedatei = Ausgabepfad & strBlatt & ".csv"

'letzte Zeile des jeweiligen Tabellenblatts ermitteln
lngLetzte = Worksheets(strBlatt).Cells(Rows.Count, 1).End(xlUp).Row

'Falls Ausgabedatei bereits besteht, wird diese gelöscht
If Dir(Ausgabedatei) <> "" Then Kill (Ausgabedatei)

'Datei Öffen zur Ausgabe
Open Ausgabedatei For Output As #1

For z = 1 To lngLetzte

  'Daten nur in CSV-Datei schreiben, wenn in Spalte C "nie dispo 55 60" steht
  If Worksheets(strBlatt).Cells(z, 3) = "nie dispo 55 60" Then

    For lngSpalte = 1 To 3
      Zeile = Trim(Worksheets(strBlatt).Cells(z, lngSpalte).Text)
      Zeile = Replace(Zeile, Trennzeichen, "") 'ggf in Text vorkommendes Trennzeichen wird gelöscht
      VollZeile = VollZeile & Zeile & Trennzeichen
    Next lngSpalte

    'Ausgabe in Datei
    VollZeile = Left(VollZeile, Len(VollZeile) - 1) 'Letztes Semicolon abschneiden
    If Len(Replace(VollZeile, Trennzeichen, "")) > 0 Then Print #1, VollZeile
    VollZeile = ""
 
  End If

Next z

Close #1 'Datei schliessen

'Bildschirmaktualiserung
Application.ScreenUpdating = True

'Abschlussmeldung
MsgBox "Nie dispo 55und60 als CSV gespeichert", 64
End Sub

Gruß

M.O.

Answer 3

Hallo Zusammen,

vielen Dank für Eure Rückmeldungen.

@ Karin: Meine Anfrage habe ich nicht ganz so ausführlich gestellt. Ich suchte tatsächlich nach einer Lösung, die genau das im Makro durchführt. :-)

@ M.O.: Vielen Dank - das Makro läuft großartig :-).

LG, Colatrinker