Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

CSV Tablellen Export, zu viele Trennzeichen

Betrifft: CSV Tablellen Export, zu viele Trennzeichen von: Vanessa
Geschrieben am: 23.10.2014 08:27:47

Hallo zusammen,

ich muss aus einer Excel Tabelle eine CSV Datei exportieren. Im Internet habe ich bereits ein Exportmakro gefunden, welches soweit sehr gut funktioniert.

Allerdings habe ich das Problem, dass die Zeichenanzahl in jeder Zeile unterschiedlich lang ist und dann in den kürzeren Zeilen, die "Leerzellen" mit Trennzeichen aufgefüllt werden. Klingt soweit logisch, ist jedoch für meine Anwendung ungeschickt.

Der folgende Makrocode wäre für den Export verantwortlich:




Sub Export()
'

 Application.ScreenUpdating = False
 
    
 'interne Variablen
 Dim a               As Variant
 Dim B()             As String
 Dim D()             As String
 Dim Z               As Long
 Dim S               As Byte
 Dim R               As Long
 Dim C               As Byte

 'Variablen für Benutzereingaben
 Dim strPfadDatNam   As String
 Dim Separator       As String
 Dim Wrapper         As String
 Dim NULLvariable    As String


 'Benutzerabfragen
    'Speicherpfad eintragen
 strPfadDatNam = Application.GetSaveAsFilename(ActiveWorkbook.FullName & "_csvexport", "  _
Textdateien (*.csv), *.csv,Textdateien (*.txt), *.txt,Alle Dateien (*.*), *.*", 1, "Speichern")
 If UCase(strPfadDatNam) = "FALSCH" Or UCase(strPfadDatNam) = "FALSE" Then Exit Sub  'Abbrechen  _
geklickt

 Separator = InputBox("Welches Zeichen soll als Trennzeichen fungieren? (default=;)", "CSV  _
Export: Trennzeichen", ";")
    'Texerkennungszeichen anpassen (kann meist so bleiben)
 Wrapper = ""
    'NULL Variable
 NULLvariable = ""

    'Zu speichernden Bereich eintragen z.B:
    'Worksheet("DeinTabellenblatt").UsedRange
    'Worksheet("DeinTabellenblatt").Range("A1:B10")

    a = ActiveSheet.UsedRange

    If Not IsEmpty(a) Then
       Z = UBound(a, 1)
       S = UBound(a, 2)
       ReDim B(S - 1)
       ReDim D(Z - 1)
       For R = 1 To Z
          For C = 1 To S
             If InStr(1, a(R, C), Separator) > 0 Then
                'Cells including the Separator
                'put in Wrapper
                B(C - 1) = Wrapper & a(R, C) & Wrapper
             ElseIf a(R, C) = "" Then
             'Empty Cells put as User-Input
                B(C - 1) = NULLvariable
             Else
                B(C - 1) = a(R, C)
             End If
          Next C
          D(R - 1) = Join(B(), Separator)
       Next R
       Open strPfadDatNam For Output As #1
       Print #1, Join(D(), vbCrLf)
       Close #1
    End If


End Sub
Das Makro kann auch hier runtergeladen werden --> https://www.herber.de/bbs/user/93300.doc

Als Ausgabedatei erhalte ich folgende Darstellung:
2;5;12,5;31,25;78,125;195,3125;488,28125;1220,703125;3051,7578125;7629,39453125;19073,486328125; _
 _
47683,7158203125;119209,289550781;298023,223876953;;;;;;;;;;
6;8;12;22;4;2222;;;;;;;;;;;;;;;;;;
2;8;9;;;;;;;;;;;;;;;;;;;;;
2;5;8;11;14;17;20;23;26;29;32;35;38;41;44;47;50;53;56;59;62;65;68;71

Wünschenswert wäre allerdings diese Art der Ausgabe:
2;5;12,5;31,25;78,125;195,3125;488,28125;1220,703125;3051,7578125;7629,39453125;19073,486328125; _
 _
47683,7158203125;119209,289550781;298023,223876953
6;8;12;22;4;2222
2;8;9
2;5;8;11;14;17;20;23;26;29;32;35;38;41;44;47;50;53;56;59;62;65;68;71

Das Makro soll also leere Zellen nicht durch Trennzeichen ersetzen.

Vielen Dank für eure Hilfe vorab.

Freundliche Grüße

Vanessa

  

Betrifft: AW: CSV Tablellen Export, zu viele Trennzeichen von: Tino
Geschrieben am: 23.10.2014 08:58:13

Hallo,
habe den Code etwas umgebaut, kannst mal testen.

Sub Export()
Dim strPfadDatNam As String
Dim Separator As String
Dim strString As String, TmpSep$
Dim F%
Dim ArData, n&
'Benutzerabfragen 
'Speicherpfad eintragen 
strPfadDatNam = Application.GetSaveAsFilename(ActiveWorkbook.FullName & "_csvexport", _
                "Textdateien (*.csv), *.csv,Textdateien (*.txt), " & _
                "*.txt,Alle Dateien (*.*), *.*", 1, "Speichern")

If strPfadDatNam = CStr(False) Then Exit Sub  'Abbrechen geklickt 

If Dir$(strPfadDatNam, vbNormal) <> "" Then Kill strPfadDatNam 'alte Datei löschen 

Separator = InputBox("Welches Zeichen soll als Trennzeichen fungieren? (default=;)" _
            , "CSV Export: Trennzeichen", ";")

TmpSep = Separator & Separator

'Zu speichernden Bereich eintragen z.B: 
'Worksheet("DeinTabellenblatt").UsedRange 
'Worksheet("DeinTabellenblatt").Range("A1:B10") 
Application.ScreenUpdating = False
ArData = ActiveSheet.UsedRange
  
F = FreeFile
Open strPfadDatNam For Append As #F
With Application
    For n = 1 To Ubound(ArData)
        strString = Join(.Index(ArData, n), Separator)
        Do While InStr(strString, TmpSep) > 0
            strString = Replace(strString, TmpSep, Separator)
        Loop
        If Right$(strString, 1) = Separator Then strString = Left$(strString, Len(strString) - 1)
    
        Print #F, strString
    Next n
End With
Close #F

Application.ScreenUpdating = True
End Sub
Gruß Tino


  

Betrifft: AW: CSV Tablellen Export, zu viele Trennzeichen von: Vanessa
Geschrieben am: 23.10.2014 13:29:32

Hallo Tino,

vielen Dank für die schnelle Antwort. Zwar verstehe ich nicht so wirklich, was dein Code genau macht, allerdings scheint er ziemlich gut zu funktionieren !

Danke dafür :)

Grüße
Vanessa


  

Betrifft: AW: CSV Tablellen Export, zu viele Trennzeichen von: Tino
Geschrieben am: 23.10.2014 15:00:49

Hallo,
dieser Code durchläuft den Bereich Zeilenweise.

Diese Zeile wird zu einem String mit dem entsprechenden Trennzeichen zusammengefasst.
strString = Join(.Index(ArData, n), Separator)

Danach werden alle doppelten Trennzeichen solange durch 1 Trennzeichen ersetzt
bis keine doppelten mehr vorhanden sind.
Do While ...
...
Loop


Nun wird ein am Ende ein evtl. vorkommendes Trennzeichen entfernt
If Right$(strString, 1) = Separator Then …

und zum Schluss der String Zeilenweise in die Textdatei geschrieben.
Print #F, strString


Gruß Tino


  

Betrifft: AW: CSV Tablellen Export, zu viele Trennzeichen von: Vanessa
Geschrieben am: 24.10.2014 06:40:01

Ahhh okay, vielen Dank für die Erklärung :)

Grüße
Vanessa


  

Betrifft: AW: CSV Tablellen Export, zu viele Trennzeichen von: daniel
Geschrieben am: 23.10.2014 09:00:08

Hi

Wenn deine Datei nur Zählen enthält, schreibe vor dem Next R folgendes:

D(R - 1) = Join(B, " ")
D(R - 1) = Trim(D(R - 1))
D(R - 1) = Replace(D(R - 1), " ", Seperator)
Gruß Daniel