CSV einlesen und umwandeln

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: CSV einlesen und umwandeln
von: Mark Fährrolfes
Geschrieben am: 25.09.2015 12:23:00

Hallo zusammen!
Ich habe ein Makro welches mir xls. Dateien einliest und an eine bestimmte Stelle kopiert. Leider steigen wir derzeit auf das CSV Format um. Daher brauche ich eine Möglichkeit CSV Dateien einzulesen und diese dann in ein anständiges Format umzuwandeln. Das derzeitige Einfügen der CSV Daten in Excel geschieht ganz normal über die dafür vorgesehene Funktion in Excel (Daten -> externe Daten aus Text). Hier trenne ich die Zeichen durch "Komma".
Leider habe ich zu wenig Erfahrung in VBA. Der nachfolgende Code ist mein Meisterwerk ;-)
Das Ziel ist es eine CSV Datei einzulesen und diese dann nach Komma getrennt an eine bestimmte Stelle einzufügen.
Dim sheetname
Dim Filename
Dim ritnr


Sub xls_einlesen_und_kopieren()
uitwerkingnaam = (Application.ActiveWorkbook.Name)
anotherfile = vbYes
Do Until anotherfile = vbNo
 
 ritnr = InputBox("Bitte Nummer des Messvorgangs eingeben (Bsp: Messung 1 = 1)", ritnr)
 
  
    Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
        If Filename = "" Then
        teller = 0
        Do Until teller = 2
         teller2 = teller + 1
         MsgBox "you must select an xls file"
         Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
        Loop
     Else
        Workbooks.Open Filename:=Filename
    End If
    
 'Messdaten befinden sich immer auf "Tabelle1" in der Excel mit den Messdaten 
sheetname = "Tabelle1"         
'Meldung des Zwischenspeichers ausblenden
Application.DisplayAlerts = False
Worksheets(sheetname).Range("A1:G55").Copy
bandnaam = (Application.ActiveWorkbook.Name)
Windows(bandnaam).Close
Windows(uitwerkingnaam).Activate
'Aufteilung der eingelesenen Daten in den dafür vorgesehenen Bereich
If ritnr = 1 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B10")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A10").Select
    Selection.Formula = bandnaam
End If
If ritnr = 2 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B70")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A70").Select
    Selection.Formula = bandnaam
End If
If ritnr = 3 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B130")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A130").Select
    Selection.Formula = bandnaam
End If
If ritnr = 4 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B190")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A190").Select
    Selection.Formula = bandnaam
End If
If ritnr = 5 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B250")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A250").Select
    Selection.Formula = bandnaam
End If
If ritnr = 6 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B310")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A310").Select
    Selection.Formula = bandnaam
End If
If ritnr = 7 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B370")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A370").Select
    Selection.Formula = bandnaam
End If
If ritnr = 8 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B430")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A430").Select
    Selection.Formula = bandnaam
End If
If ritnr = 9 Then
 ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B490")
    Worksheets("Datenblatt").Activate
    Worksheets("Datenblatt").Range("A490").Select
    Selection.Formula = bandnaam
End If
'Meldung des Zwischenspeichers einblenden
Application.DisplayAlerts = True
Worksheets("Home").Activate
Worksheets("Home").Range("B18").Select
anotherfile = MsgBox("Möchten sie einen weiteren Satz hinzufügen?", vbYesNo)
Loop
End 

Sub  

Bild

Betrifft: AW: CSV einlesen und umwandeln
von: Daniel
Geschrieben am: 25.09.2015 15:29:08
Hi
du kannst die CSV-Datei normal mit Workbooks.Open Filename:=Filename öffnen.
das Problem ist, dass es zwei sorten von CSV-Dateien gibt:
- englische
- deutsche
diese unterscheiden sich im verwendeten Trennzeichen (englisch: Komma, deutsch: Semikolon), in Dezimalzeichen für Zahlen (englisch: Punkt, deutsch: Komma) und ggf in der Datumsschreibweise.
wenn du das Workbooks.Open wie oben gezeigt einsetzt, geht VBA von einer englischen CSV aus.
willst du jedoch deutsche CSV lesen, musst du zusätzlich den Parameter: Local:=True angeben:
Workbooks.Open Filename:=Filename, Local:=True
bei GetOpenFileName tauschst du dann das "xls" durch "csv"
Gruß Daniel

Bild

Betrifft: AW: CSV einlesen und umwandeln
von: matthias
Geschrieben am: 25.09.2015 22:03:37
Hallo Mark,
ich find ja deine Endlosschleife sehr hübsch. Dazu kommt es nur nicht. Klicke ich einmal auf Abbrechen, stürzt dein Makro nämlich schon ab:

If Filename = "" Then
    teller = 0
    Do Until teller = 2
       teller2 = teller + 1
       MsgBox "you must select an xls file"
       Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
    Loop
 Else
    Workbooks.Open Filename:=Filename
 End If

Grund: GetOpen gibt beim Abbrechen nicht "" (Nichts) sondern "Falsch" zurück (kein Text! weil Filename als Variant deklariert ist). Damit wird dein Else getriggert und Workbook.Open sucht nach "Falsch.xls", was natürlich nicht gefunden wird.
Daher muss es lauten: If Filename = False Then
Warum meinte ich am Anfang Endlos-Schleife? Sofern die korrigierte If-Abfrage zutrifft, werde ich deine Do-Loop-Schleife geleitet, wo ich noch zwei weitere Male die Chance bekomme eine Datei auszuwählen. Durch deinen Tippfehler wird "teller" aber nicht hochgezählt, sondern bleibt Null: teller = teller +1
Sowas ließe sich vermeiden wenn man unter Optionen "Variablendeklaration erforderlich" ein Häkchen setzt. Der Name sagt dabei schon alles. Vertippst du dich, meckert er weil er die Variable nicht kennt und du kannst deinen Fehler korrigieren.
Desweiteren musst du nach deiner Schleife wieder abfragen ob der Filename gültig ist oder nicht, sonst läuft das ganze wieder auf Grund. Dann musst du die Grundeinstellungen wiederherstellen und das Makro abbrechen.
Ist dein Name dann jedoch gültig, so muss Workbook.Open gelten, tut es aber nicht, wenn es in deinem Else stehen bleibt, da haben wir mit dem ersten Klick auf Abbrechen uns nämlich schon daran vorbeimanövriert. Daher wandert das bei mir nach unten.
So sollte es funktionieren:
'...
Start:
ritnr = InputBox("Bitte Nummer des Messvorgangs eingeben (Bsp: Messung 1 = 1)", ritnr)
Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
If Filename = False Then
    teller = 0
    Do Until teller = 2
        teller = teller + 1
        MsgBox "you must select an xls file"
        Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
        If Filename <> False Then teller = 2
    Loop
    If Filename = False Then
        If MsgBox("Möchten den Vorgang abbrechen?", vbYesNo) = vbYes Then
            Application.DisplayAlerts = True 'Grundeinstellungen
            Worksheets("Home").Activate
            Worksheets("Home").Range("B18").Select
            Exit Sub 'Makro beenden
        Else: GoTo Start
        End If
    End If
End If
Workbooks.Open Filename:=Filename
'...
lg Matthias

Bild

Betrifft: AW: CSV einlesen und umwandeln
von: Mark Fährrolfes
Geschrieben am: 28.09.2015 14:54:49
Vielen Dank für die Tipps. Ich habe das Problem jetzt gelöst.
Ich kann jetzt einzelne CSV Dateien einlesen und an bestimmte Stellen kopieren.
Folgender Code ist jetzt Final:

Sub CSV_einlesen()
   Dim neudatei
   
   uitwerkingnaam = (Application.ActiveWorkbook.Name)
anotherfile = vbYes
Do Until anotherfile = vbNo
   
Start:
mnr = InputBox("Bitte Nummer des Messvorgangs eingeben (Bsp: Messung 1 = 1)", mnr)
   
   neudatei = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv")
   If neudatei = False Then
    
   'unnötige Wiederholung der Schleife:
    'teller = 0
    'Do Until teller = 2
     '   teller = teller + 1
      '  MsgBox "Sie müssen eine CSV Datei auswählen!"
       ' neudatei = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv")
        'If neudatei <> False Then teller = 2
        
     'Loop
    'If neudatei = False Then
    
    
        If MsgBox("Möchten den Vorgang abbrechen?", vbYesNo) = vbYes Then
            Application.DisplayAlerts = True 'Grundeinstellungen
            Worksheets("Home").Activate
            Exit 

Sub                           'Makro beenden
        Else: GoTo Start
   End If
   End If
   'End If
   
   
  
  ' LeseFunktion aufrufen
   If mnr = 1 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple1 CStr(neudatei)
  
   Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B10:B65").Select
    Selection.TextToColumns Destination:=Range("B10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   End If
   
     If mnr = 2 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple2 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B70:B125").Select
    Selection.TextToColumns Destination:=Range("B70"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   
  
   End If
   
      If mnr = 3 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple3 CStr(neudatei)
 Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B130:B185").Select
    Selection.TextToColumns Destination:=Range("B130"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   
   
  
   End If
   If mnr = 4 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple4 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B190:B245").Select
    Selection.TextToColumns Destination:=Range("B190"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   
   End If
  
      If mnr = 5 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple5 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B250:B305").Select
    Selection.TextToColumns Destination:=Range("B250"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   
   End If
   
      If mnr = 6 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple6 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B310:B365").Select
    Selection.TextToColumns Destination:=Range("B310"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
  
   End If
   
      If mnr = 7 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple7 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B370:B425").Select
    Selection.TextToColumns Destination:=Range("B370"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
   
   End If
   
      If mnr = 8 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple8 CStr(neudatei)
   
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B430:B486").Select
    Selection.TextToColumns Destination:=Range("B430"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
 
   End If
   
      If mnr = 9 Then
   Worksheets("Datenblatt").Activate
   ReadfromCSVSimple9 CStr(neudatei)
    Worksheets("Datenblatt").Activate        'Umwandeln mit Komma getrennt
    Range("B490:B546").Select
    Selection.TextToColumns Destination:=Range("B490"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
   Worksheets("Home").Activate              'Ende Umwandeln
  
  MsgBox ("Sie haben die maximale Anzahl an Sätzen eingegeben!") 'keine weiteren Sätze mehr mö _
glich
  GoTo Ende
   End If
   
   If mnr > 9 Then
   MsgBox ("Sie können nur Messnummern von 1 - 9 eingeben!") 'Nummer zu groß
   End If
   
    
   
   Worksheets("Home").Activate
anotherfile = MsgBox("Möchten sie einen weiteren Satz hinzufügen?", vbYesNo)
Loop
Ende:
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "CSV einlesen und umwandeln"