Problem beim Laden von .csv Dateien

Hallo Zusammen,
bin bisher nur stiller Mitleser gewesen, habe aber jetzt ein Problem, dass ich nicht alleine gelöst bekomme.
Ich lade .csv Dateien aus einem ordner mit dem nachfolgenden Skript ein. Das funktioniert auch ohne Fehler, aber die Darstellung der Daten ist nicht richtig.

Sub ImportiereCSVDateien()
Const CSVPFAD = "Pfad einfügen"
Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.Filesystemobject")
Set wbTarget = ActiveWorkbook
Application.DisplayAlerts = False
'Lösche alle Worksheets bevor wir alle neu anlegen
If wbTarget.Worksheets.Count > 1 Then
For i = 1 To wbTarget.Worksheets.Count - 1
wbTarget.Worksheets(i).Delete
Next
End If
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Workbooks.OpenText Filename:=f.Path
Set wbSource = ActiveWorkbook
On Error Resume Next
Set ws = wbTarget.Worksheets(f.Name)
If Err  0 Then
Set ws = wbTarget.Worksheets.Add
ws.Name = f.Name
ws.Range("A:ZZ").Clear
End If
wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"),  _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
wbSource.Close False
End If
Next
Application.DisplayAlerts = True
Set fso = Nothing
End Sub

Das Ergebnis sieht dann wie folgt aus.
Userbild

Das Problem: Spalte B & C sind eine Zeile nach unten verschoben und in Zeile A hab ich anstelle eines Kommas einenPunkt als Trennzeichen.
Dazu ist zu sagen dass die .csv Datei eine Leerzeile zu beginn hat, welche nachher auch verschwunden ist.
Ich habe den Code oben nicht selbt geschrieben, sondern kopiert, bekomme ihn aber nicht so verändert, dass alles richtig dargestellt wird.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

$Pfad = $env:USERPROFILE $url = $Pfad + '\Desktop\Mess-Daten.txt' $data = get-content $url $Ar = @() foreach ($ll in $data) { if ($ll.length -gt 40){ #Write-Host $ll $zz = $ll.Split(',') $Ar += [string][double]$zz[0] + '|' + [double]$zz[1] + '|' + [double]$zz[2] } } $Ar | Out-File ($Pfad + '\Desktop\Mess.txt')

Sub alle_Dateien_Verzeichnis() 'Definieren der Arrays Dim X(1 To 100, 1 To 4) Dim Y(1 To 100, 1 To 4) Dim Z(1 To 100, 1 To 4) Dim i As Long Dim k As Long i = 1 'Dateipfad einlesen und Dateien Laden strPath = "Pfad......" 'Pfad des Verzeichnisses ggf. anpassen strExt = "*.csv" Dim strFile As String If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile 'Auslesen der letzten Zeile des Workbooks letztezeile = Range("A65536").End(xlUp).Row 'Beschreiben der Arrays mit den Koordinaten k = 1 For n = 1 To letztezeile If Cells(i, 1) = ("X [ m ]") Then X(k, i) = Cells(n, 1).Offset(1, 0) Y(k, i) = Cells(n, 1).Offset(1, 1) Z(k, i) = Cells(n, 1).Offset(1, 2) k = k + 1 End If Next i = i + 1 'Geöffnetes Workbook schließen und weiter mit nächstem Workbooks(strFile).Close strFile = Dir() Loop End If

Hallo Lucas,
deine Arrays habe ich nicht verstanden. Gibt es nur 4 Dateien?
Teste mal:

Option Explicit

Sub alle_Dateien_Verzeichnis()

    Const FOLDER_PATH As String = "H:\1111\"
    Const FILE_EXTENSION As String = "*.csv"

    'Definieren der Arrays
    Dim X(1 To 100, 1 To 4) As Double
    Dim Y(1 To 100, 1 To 4) As Double
    Dim Z(1 To 100, 1 To 4) As Double
    Dim i As Long
    Dim k As Long
    Dim n As Long
    Dim strFile As String
    Dim objWorkbook As Workbook

    strFile = Dir$(FOLDER_PATH & FILE_EXTENSION)

    Do Until strFile = vbNullString

        Set objWorkbook = Workbooks.Open(Filename:=FOLDER_PATH & strFile)

        With objWorkbook.Worksheets(1)

            'Beschreiben der Arrays mit den Koordinaten

            k = 1

            i = i + 1

            For n = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row

                If .Cells(n, 1).Value = "X [ m ]" Then

                    X(k, i) = .Cells(n, 1).Offset(1, 0)
                    Y(k, i) = .Cells(n, 1).Offset(1, 1)
                    Z(k, i) = .Cells(n, 1).Offset(1, 2)
                    k = k + 1

                End If
            Next
        End With

        'Geöffnetes Workbook schließen und weiter mit nächstem
        Call objWorkbook.Close(SaveChanges:=False)

        Set objWorkbook = Nothing

        strFile = Dir$

    Loop

    'weiterer Code

End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Problem beim Laden von .csv Dateien

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread