Spalten eines eingefügten Sheets werden unplanmäßig gelöscht
#1
Hallo liebes Excel-Forum.
Mein Programm läuft fast, es verbleibt ein kleiner bug.
Wenn ich neue Blätter (Sheets) einfüge, werden alle Werte in Spalten größer 3 (also d und Fortfolgende) gelöscht.
Sieht Jemand, warum das so ist?

'_________________________

'ERFASSEN tatsächlich vorhandener Dateien
Dim wbCSV As Workbook
Dim wbAUSWERTUNG As Workbook
Dim ws As Worksheet
Dim WSNumber As Integer
Set fso = CreateObject("Scripting.Filesystemobject")
Set wbAUSWERTUNG = ActiveWorkbook
 Application.DisplayAlerts = False
 'Alle älteren Datenblätter löschen vorher
    For i = 1 To wbAUSWERTUNG.Worksheets.Count
         If i > 3 Then
            wbAUSWERTUNG.Worksheets(i).Delete
         End If
     Next
'____________________
'Jetzt einlesen. ES WERDEN ALLE SPALTEN > 3 GELÖSCHT!!! muss repariert werden
'--------------------
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(Right(f.Name, 3)) = "csv" Then
            Workbooks.OpenText Filename:=f.Path
            Set wbCSV = ActiveWorkbook
            On Error Resume Next
            Set ws = wbAUSWERTUNG.Worksheets(f.Name)
            If Err <> 0 Then
                Set ws = wbAUSWERTUNG.Worksheets.Add(after:=Sheets(Sheets.Count))
                ws.Name = f.Name
                ws.Range("A:ZZ").Clear
            End If
            wbCSV.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
            wbCSV.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
            wbCSV.Close False
        End If
    Next
    Application.DisplayAlerts = True
    Set fso = Nothing 

______________________
Vielen lieben Dank für Hinweise!
Top
#2
Hallo Hannes,

vermutlich enthalten die CSV-Dateien pro Zeile nur zwei Semikolons.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Hannes_Ulbricht
Top
#3
Start time;22.09.2019 22 : 22 : 22
Recipe;deletedname 310
Run time[s];2222
Time[s];Step;Temperature setpoint[°C];Temperature current[°C];Temperature left/front[°C];Temperature left/rear[°C];Temperature right/front[°C];Temperature right/rear[°C];Sensor1[°C];Sensor2[°C];Sensor3[°C];Sensor4[°C];Pressure relative setpoint[mbar];Pressure relative current[mbar];Pressure absolute setpoint[mbar];Pressure absolute current[mbar];Massflow MATERIAL setpoint[l/min];Massflow MATERIAL current[l/min];Valve vacuum[%]
0;1;0,0;26,0;25,8;25,3;26,0;25,5;999,0;23,8;64,4;23,8;0;-186;0,0000;971,5154;0,0;0,0;100

ich habe mal die Daten verfälscht und den Namen.
Dies ist die Struktur der CSV Sheets, nur die ersten paar zeilen als Beispiel.
Ich hatte bereits in einer älteren Version alle Daten erfolgreich kopiert, konnte diese aber nicht wieder nachbauen.
Das liegt eben daran, dass ich nicht weis, was in meinem COPY CODE falsch ist/sich geändert hat.
An den Quelldaten liegt es meines (laienhaften) Erachtens nach nicht.
Top
#4
Hallo Hannes,

ändere mal die Zeile
Code:
  wbCSV.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
in
Code:
 wbCSV.Worksheets(1).Range("A:A").TextToColumns Destination:=wbCSV.Worksheets(1).Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True

Gruß Uwe
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste