kaban378
Goto Top

SCV Protokoll Import Problem

Hallo Leute,
habe ein Problem beim CSV Dateien Import:

der Import an sich klappt bereits, nur werden einige Daten nicht ausgelesen: hier mein Quelltext:

*
Sub ImportiereCSVDateien()
    Const CSVPFAD = "C:\Users\Brakk\Desktop\Test\Daten"  
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, curCell As Range
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set wbTarget = ThisWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'Lösche alle Worksheets bevor wir alle neu anlegen  
    While wbTarget.Worksheets.Count > 1
        wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"  
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
    For Each f In fso.GetFolder(CSVPFAD).Files
       If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
            ws.Name = f.Name
            ws.Range("A:ZZ").Clear  
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
            wbSource.Worksheets(1).UsedRange.Copy Destination:=ws.Range("A1")  
            wbSource.Close False
        End If
    Next
    
    With wbTarget.Worksheets("Zusammenfassung")  
        Set curCell = .Range("B1")  
        For i = 2 To wbTarget.Worksheets.Count
            'Inhalt der CSV in das Zusammenfassungs-Sheet kopieren  
            wbTarget.Sheets(i).UsedRange.Copy Destination:=curCell
            wbTarget.Sheets(i).UsedRange.Copy
            'Name der Quelle in Spalte A schreiben  
            curCell.Offset(0, -1).Value = wbTarget.Sheets(i).Name
            'Zelle für nächsten Import setzen  
            Set curCell = curCell.Offset(wbTarget.Sheets(i).UsedRange.Rows.Count + 2, 0)
        Next
        'Spaltengröße im Zusammenfassungssheet automatisch anpassen  
        .UsedRange.EntireColumn.AutoFit
        .Select
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub


Das Problem ist, dass im CSV Protokoll das Tab-Zeichen eine Comma darstellt(glaube ich) und ich nicht weiß, wie ich dieses an das Excel so weiter gebe...d.h., dass im protokol steht z.B:


A1: "Konzentration Behälter 1;0" B1:"726;Einheit;Datum"

importieren tut er folgend: A1:"Konzentration Behälter 1", A2:"0"; A3:"Einheit", A4:"Datum",

Die wichtigste Kenngröße "0,726" wird nicht dargestellt.


Ich bitte um Entschuldigung für die hat fachgemäße Fragestellung, hoffe aber, dass mir jemand dabei helfen könnte.


Mit freundlichen Grüßen

kaban378

Content-Key: 348739

Url: https://administrator.de/contentid/348739

Ausgedruckt am: 19.03.2024 um 11:03 Uhr

Mitglied: Meierjo
Meierjo 11.09.2017 um 13:13:47 Uhr
Goto Top
Hallo

Probier mal in der Zeile 22
  wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True   

durch

wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, TrailingMinusNumbers:=True  

zu ersetzen (ungetestet)

Gruss
Mitglied: kaban378
kaban378 11.09.2017 um 13:25:16 Uhr
Goto Top
Hallo Meierjo,

vielen Dank für deine Antwort.
Habe es ausprobiert: Excel wiedergibt es alles mit den Trennzeichen ";" in zwei Spalten...

MfG

kaban378
Mitglied: kaban378
kaban378 11.09.2017 um 14:11:11 Uhr
Goto Top
Eine Berichtigung: in dem Protokoll ist der Erforderliche Wert als "xx,xxx" dargestellt, wie bringe ich Excel dazu, das Komma auch als eine Komma, also als Wertbestandteil zu verstehen?
Mitglied: Meierjo
Meierjo 11.09.2017 aktualisiert um 15:23:56 Uhr
Goto Top
Hallo

Wie jetzt, du hast als Feldtrenner Komma's, und innerhalb der Werte auch kommagetrennt??

Dann musst du zwingend den Feldtrenner im CSV ändern, denn woher soll Excel sonst wissen, welches Komma Feldtrenner und welches Komma zum Wert gehört

Gruss
Mitglied: 133883
133883 11.09.2017 um 15:26:15 Uhr
Goto Top
A1: "Konzentration Behälter 1;0" B1:"726;Einheit;Datum"
importieren tut er folgend: A1:"Konzentration Behälter 1", A2:"0"; A3:"Einheit", A4:"Datum",
Die wichtigste Kenngröße "0,726" wird nicht dargestellt.
Naja wie soll Excel aus 726 ein 0,726 Interpretieren???

Und außerdem fehlt ein wichtiger Parameter namens Local:=True

Gruß
Mitglied: kaban378
kaban378 11.09.2017 um 16:04:15 Uhr
Goto Top
Hallo Meierjo,

ich glaube ich habe das Problem falsch geschildert:

das csv-Protokoll sieht folgend aus:" Istkonzentration Behälter 1;0,726;g/g;2017-08-31 10:10:16"

Das Problem ist, dass er die Nachkommastellen nicht mittzieht....

Da ich eher keine Ahnung vom vba habe, weiß ich nicht, wieso er es nicht macht...
Mitglied: 133883
133883 11.09.2017 aktualisiert um 16:08:22 Uhr
Goto Top
Zitat von @kaban378:

Hallo Meierjo,

ich glaube ich habe das Problem falsch geschildert:

das csv-Protokoll sieht folgend aus:" Istkonzentration Behälter 1;0,726;g/g;2017-08-31 10:10:16"
Die Anführungszeichen am Anfang und Ende sind zu viel.
Das Problem ist, dass er die Nachkommastellen nicht mittzieht....
s.o. Parameter Hinweis.

P.s. es gibt links in der Symbolleiste ein Icon zum Posten von Quellcode und damit solltest du auch deine CSV Daten posten! Danke!
Mitglied: kaban378
kaban378 11.09.2017 um 16:26:48 Uhr
Goto Top
Oneplus, vielen dank für deine Antwort.

Das Problem ist, dass er die Nachkommastellen nicht mittzieht....
s.o. Parameter Hinweis.

P.s. es gibt links in der Symbolleiste ein Icon zum Posten von Quellcode und damit solltest du auch deine CSV Daten posten! Danke!

Vielen Dank für den Hinweis, bin neu hier. Bitte um Entschuldigung...

Leider klappts mit dem, von dir vorgeschlagenen Parameter nicht. Bzw. ich füge diesen in der falschen Zeile ein...

Habe vor 2 Tagen erst erfahren, was VBA ist...also bitte ich meine Dummheit in der Materie zu entschuldigen und in Kauf zu nehmen.
Mitglied: 133883
133883 11.09.2017 aktualisiert um 16:40:32 Uhr
Goto Top
Dann bin ich raus, fremden Code ohne Quellenangabe hier posten ohne minimales Grundwissen unterstütze ich nicht.
Mitglied: kaban378
kaban378 11.09.2017 um 16:56:47 Uhr
Goto Top
Der Quellcode stamm vom colinardo,

habe den im Forum gefunden, dieser wurde vor ca. 2 Jahren hier veröffentlicht. Das mit der Quelle macht´s man so wirklich nicht...tut mir echt leid, in der Zukunft werde ich's beachten...
Und mit dem Grundwissen ist es so, dass ich gerade dabei bin, etwas über VBA zu lernen...

Wäre wirklich nett, wenn du mir helfen könntest.


MfG

kaban378
Mitglied: Meierjo
Lösung Meierjo 11.09.2017 um 17:47:46 Uhr
Goto Top
Hallo

Stelle doch mal 2-3 Zeilen von der CSV hier rein, dann wird's einfacher face-smile

Gruss
Mitglied: kaban378
kaban378 11.09.2017 um 19:08:11 Uhr
Goto Top
Hallo Meierjo,

Ein Protokoll sieht folgend aus:

Istkonzentration Behälter 1;0,726;g/g;2017-08-31 10:10:16


Davon es gibt ca 40 Stück täglich. Dazu kommen aber noch Andere, die ausgewertet werden müssen...

Bis jetzt werden die alle manuell ausgewertet, ich möchte es jetzt automatisieren...
Mitglied: Meierjo
Lösung Meierjo 11.09.2017 um 20:30:22 Uhr
Goto Top
Hallo

Probier mal das hier

Sub ImportiereCSVDateien()
    Const CSVPFAD = "C:\Users\Brakk\Desktop\Test\Daten"  
        Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, curCell As Range
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set wbTarget = ThisWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    'Lösche alle Worksheets bevor wir alle neu anlegen  
    While wbTarget.Worksheets.Count > 1
        wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"  
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
    For Each f In fso.GetFolder(CSVPFAD).Files
       If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            'Workbooks.OpenText Filename:=f.Path  
            Workbooks.Open Filename:=f.Path, local:=True
            Range("A:A").TextToColumns , DataType:=xlDelimited, Semicolon:=True  
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
            ws.Name = f.Name
            ws.Range("A:ZZ").Clear  
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
            wbSource.Worksheets(1).UsedRange.Copy Destination:=ws.Range("A1")  
            wbSource.Close False
        End If
    Next
    
    With wbTarget.Worksheets("Zusammenfassung")  
        Set curCell = .Range("B1")  
        For i = 2 To wbTarget.Worksheets.Count
            'Inhalt der CSV in das Zusammenfassungs-Sheet kopieren  
            wbTarget.Sheets(i).UsedRange.Copy Destination:=curCell
            wbTarget.Sheets(i).UsedRange.Copy
            'Name der Quelle in Spalte A schreiben  
            curCell.Offset(0, -1).Value = wbTarget.Sheets(i).Name
            'Zelle für nächsten Import setzen  
            Set curCell = curCell.Offset(wbTarget.Sheets(i).UsedRange.Rows.Count + 2, 0)
        Next
        'Spaltengröße im Zusammenfassungssheet automatisch anpassen  
        .UsedRange.EntireColumn.AutoFit
        .Select
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub

Import sieht soweit ich das sehe gut aus, was du dann mit dem restlichen Code noch machen willst, weiss ich nicht, deshalb kann ich auch nicht sagen, ob das so korrekt ist

Gruss
Mitglied: kaban378
kaban378 12.09.2017 um 08:06:10 Uhr
Goto Top
Guten morgen, Meierjoface-smile

Es funktioniert! Vielen herzlichen Dank für deine Hilfe.

MfG

kaban378