Erstellung .csv ohne Übergabe der leeren Zeilen
05.06.2009 14:44:18
Klemens
benutze ein Makro, das mir als Ausgabedatei eine .csv Datei erstellt. Die Ausgabe als solches funktioniert.
Allerdings habe ich das Problem dass nicht nur die Zeilen mit Inhalten ausgegeben werden sondern auch diejenigen ohne Inhalte. Die csv.-Datei wird aus einem Arbeitsblatt heraus erzeugt, dass viele Formeln enthält.
Die .csv-Datei sieht z.B. so aus:
2T;20090503;;;P1A_010;010 ;;;;Test 1;;;;;;;312087;
2T;20090504;;;P1A_010;010 ;;;;Test 2;;;;;;;456987;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Zeile 1 und Zeile 2 waren also mit Inhalten gefüllt, Zeile 3 und 4 nicht.
Nun möchte ich dass Zeile 3 und 4 überhaupt nicht mit in die .csv-Datei übernommen werden.
Kann mir jemand helfen ?
Hier noch der Code:
Sub exportiere()
Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
'strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", _
strMappenpfad)
'If strDateiname = "" Then Exit Sub
varRetVal = Application.GetSaveAsFilename( _
InitialFileName:=strInitName, _
FileFilter:="CSV-Dateien (*.csv), *.csv", _
Title:="Daten exportieren in CSV-Datei")
If varRetVal = False Then Exit Sub
strDateiname = varRetVal
LetzteZeile = (Sheets("Ausgabe").Cells(Cells.Rows.count, 4).End(xlUp).Row)
Sheets("Ausgabe").Activate
Set Bereich = ActiveSheet.Range(Cells(6, 3), Cells(LetzteZeile, 64))
' Set Bereich = Sheets("Ausgabe").Range(Cells(6, 3), Cells(1005, 64))
strTrennzeichen = ";"
Open strDateiname For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
' Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next
Close #1
Set Bereich = Nothing
MsgBox "Datei wurde erfolgreich exportiert nach" & vbCrLf & strDateiname
MsgBox "Die Datei wird automatisch geschlossen!"
Sheets("Eingabe").Activate
Call Inhalte_löschen
directExit = True
Application.DisplayAlerts = False
Application.Quit
End Sub
Danke !
Grüße
Klemens