BLinz am 21. Januar 2012 um 21:21 Uhr

2012-01-21T21:21:10Z

Neue Seite

[[Kategorie:Office]][[Kategorie:Excel]][[Kategorie:VBA]]
Wenn eine Tabelle in Excel als '''''.csv''''' gespeichert wird, handelt es sich hierbei nicht um eine echte CSV Datei - Excel benutzt z.B. kein Komma als Trennzeichen. Mit nachfolgendem VBA Script geht es doch:

<syntaxhighlight lang="vb">

Sub SaveCSV()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen
' von Nils Kaczenski (Vorname at nachname .de), 30.1.2003
' Ohne Gewähr!
' Überarbeitet Dezember 2008 durch Bernhard Linz,
' DATAGROUP Bremen GmbH
' Bernhard.Linz@datagroup.de
' Export wurde angepasst damit Zellen, die mit ####### angezeigt werden
' auch richtig mit Wert und nicht mit #### exportiert werden

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

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If Zelle.Value = 0 Then
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
Else
If InStr(1, Zelle.Value, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
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 exportiert nach" & vbCrLf & strDateiname

End Sub

</syntaxhighlight>
<comments />

Office:Excel Echter CSV Export - Versionsgeschichte

BLinz am 21. Januar 2012 um 21:21 Uhr