Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
CSV einlesen und umwandeln
25.09.2015 12:23:00
Mark
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV einlesen und umwandeln
25.09.2015 15:29:08
Daniel
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

Anzeige
AW: CSV einlesen und umwandeln
25.09.2015 22:03:37
matthias
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

Anzeige
AW: CSV einlesen und umwandeln
28.09.2015 14:54:49
Mark
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

Anzeige

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige