
146311
16.10.2020, aktualisiert um 17:19:50 Uhr
Excel Makro .csv Files
Hallo Community,
Ich bekomme Messergebnisse als .csv Files diese habe ich schon geschafft per Marko einzulesen.
Allerdings werden die Files jetzt untereinander Eingefügt.
Da ich nicht weis wie viele messungen pro Tag gemacht werden und wie viele Messergebnisse pro Messung kommen, hätte ich gernen die Messergebnisse nebeneinander kopiert.
Diese würde ich dann gern in eine Tabelle kopieren mit einem loop. Solange ein Wert in einer Zelle >0 in einer Zelle ist würde ich diesen Werten gern in eine Tabelle kopieren.
Die Tabelle sollte danach noch mit einem Diagramm verknüpft werden. wobei jedes File eine Linie in dem Diagramm darstellen soll.
Wie schaffe ich es umzusetzten die .csv files nebeneindaer zu kopieren und dann noch in eine Tabelle in einem neue Arbeitsballt zu kopieren ?
Hier mein bereits vorhandenes makro:
Sub ImportCSVFromFolder()
Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String, curRow As Range, rng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\muster\Desktop"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
CSVPFAD = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Legt das CSV-Trennzeichen für die Dateien fest
strCSVDelimiter = ";"
Set fso = CreateObject("Scripting.Filesystemobject")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Zielarbeitsblatt für die importierten Daten
Set wsTarget = Worksheets(2)
wsTarget.Name = "Zusammenfassung"
'temporäres Arbeitsblatt für den Import der Daten erstellen
Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Inhalt des Zusammenfassungsblattes löschen
wsTarget.UsedRange.Clear
'Startausgabezelle festlegen
Set curCell = wsTarget.Range("A1")
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
'Temporäres Sheet löschen
wsTemp.UsedRange.Clear
'CSV-Daten in Temporäres Sheet importieren
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))
.Name = "import"
.FieldNames = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileOtherDelimiter = strCSVDelimiter
.Refresh BackgroundQuery:=False
.Delete
End With
With wsTemp
'Daten in Zielsheet kopieren
.UsedRange.Copy curCell
End With
'Ausgabezeile eins nach unten schieben
Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1)
' Set curRow = wsTarget.Rows(wsTarget.UsedRange.Columns.Count + 3, 1)
End If
Next
'Temporäres Sheet löschen
wsTemp.Delete
'Spalten anpassen
wsTarget.Columns.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Vorgang beendet! ", vbInformation
Set fso = Nothing
End Sub
Und hier noch ein Beispiel wie meine csv Datein aufgebaut sind:
500_P2
Blechlänge: 500 mm
Blechstärke: 10 mm/10
Randabstand: 30 mm
Messpunkte: 44
Startposition: 820 mm
850.011620378998;88.370002746582;88.370002746582
860.244491278656;88.5500030517578;88.5500030517578
870.476999533905;88.4700012207031;88.4700012207031
880.709393269866;88.5199966430664;88.5199966430664
890.941901525119;88.5199966430664;88.5199966430664
901.174428866914;88.370002746582;88.370002746582
911.406822602876;88.4800033569336;88.4800033569336
921.639559896699;88.4199981689453;88.4199981689453
931.872430796357;88.4599990844727;88.4599990844727
Ich bekomme Messergebnisse als .csv Files diese habe ich schon geschafft per Marko einzulesen.
Allerdings werden die Files jetzt untereinander Eingefügt.
Da ich nicht weis wie viele messungen pro Tag gemacht werden und wie viele Messergebnisse pro Messung kommen, hätte ich gernen die Messergebnisse nebeneinander kopiert.
Diese würde ich dann gern in eine Tabelle kopieren mit einem loop. Solange ein Wert in einer Zelle >0 in einer Zelle ist würde ich diesen Werten gern in eine Tabelle kopieren.
Die Tabelle sollte danach noch mit einem Diagramm verknüpft werden. wobei jedes File eine Linie in dem Diagramm darstellen soll.
Wie schaffe ich es umzusetzten die .csv files nebeneindaer zu kopieren und dann noch in eine Tabelle in einem neue Arbeitsballt zu kopieren ?
Hier mein bereits vorhandenes makro:
Sub ImportCSVFromFolder()
Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String, curRow As Range, rng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "D:\muster\Desktop"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
CSVPFAD = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Legt das CSV-Trennzeichen für die Dateien fest
strCSVDelimiter = ";"
Set fso = CreateObject("Scripting.Filesystemobject")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Zielarbeitsblatt für die importierten Daten
Set wsTarget = Worksheets(2)
wsTarget.Name = "Zusammenfassung"
'temporäres Arbeitsblatt für den Import der Daten erstellen
Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Inhalt des Zusammenfassungsblattes löschen
wsTarget.UsedRange.Clear
'Startausgabezelle festlegen
Set curCell = wsTarget.Range("A1")
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
'Temporäres Sheet löschen
wsTemp.UsedRange.Clear
'CSV-Daten in Temporäres Sheet importieren
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))
.Name = "import"
.FieldNames = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileOtherDelimiter = strCSVDelimiter
.Refresh BackgroundQuery:=False
.Delete
End With
With wsTemp
'Daten in Zielsheet kopieren
.UsedRange.Copy curCell
End With
'Ausgabezeile eins nach unten schieben
Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1)
' Set curRow = wsTarget.Rows(wsTarget.UsedRange.Columns.Count + 3, 1)
End If
Next
'Temporäres Sheet löschen
wsTemp.Delete
'Spalten anpassen
wsTarget.Columns.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Vorgang beendet! ", vbInformation
Set fso = Nothing
End Sub
Und hier noch ein Beispiel wie meine csv Datein aufgebaut sind:
500_P2
Blechlänge: 500 mm
Blechstärke: 10 mm/10
Randabstand: 30 mm
Messpunkte: 44
Startposition: 820 mm
850.011620378998;88.370002746582;88.370002746582
860.244491278656;88.5500030517578;88.5500030517578
870.476999533905;88.4700012207031;88.4700012207031
880.709393269866;88.5199966430664;88.5199966430664
890.941901525119;88.5199966430664;88.5199966430664
901.174428866914;88.370002746582;88.370002746582
911.406822602876;88.4800033569336;88.4800033569336
921.639559896699;88.4199981689453;88.4199981689453
931.872430796357;88.4599990844727;88.4599990844727
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 613460
Url: https://administrator.de/forum/excel-makro-csv-files-613460.html
Ausgedruckt am: 30.04.2025 um 21:04 Uhr
3 Kommentare
Neuester Kommentar

Moinsens.
p.s. Formatierungen in den Beiträgen
🐟
Gruß w.
Excel Marko .csv Files
Also einen Marko mit dem Namen ".csv" kenn ich leider nicht.per Marko einzulesen
Warum macht das der Marko und nicht der Detlef?Hier mein bereits vorhandenes makro:
Wieso kannst du es nicht selbst anpassen wenn du es selbst geschrieben hast?? Oder nur wieder irgendwoher kopiert ohne die Quelle zu nennen?p.s. Formatierungen in den Beiträgen
Und hier noch ein Beispiel wie meine csv Datein aufgebaut sind:
ebenfalls Formatierungen in den Beiträgen🐟
Gruß w.

Zitat von @146311:
Ich habs mir selbst zusammen gestöpselt ;)
Ja nee is klaaarIch habs mir selbst zusammen gestöpselt ;)
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen