Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Frage Entwicklung VB for Applications

GELÖST

Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen Teil 2

Mitglied: sommer2013

sommer2013 (Level 1) - Jetzt verbinden

11.03.2014, aktualisiert 11:11 Uhr, 5321 Aufrufe, 12 Kommentare, 2 Danke

Hallo zusammen,

ich bin wie so mancher auch neu hier und habe zu einem Problem von mir hier die fast die perfekte Antwort gefunden:

unter "Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen" hier im Forum vom 27.08.2013 habe ich ein Spitzen VBA-Macro von Uwe alias colinardo gefunden.

01.
 
02.
Sub ImportiereCSVDateien() 
03.
    Const CSVPFAD = "E:\csv-dateien" 
04.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet 
05.
    Set fso = CreateObject("Scripting.Filesystemobject") 
06.
    Set wbTarget = ActiveWorkbook 
07.
    Application.DisplayAlerts = False 
08.
    'Lösche alle Worksheets bevor wir alle neu anlegen 
09.
    While wbTarget.Worksheets.Count > 1 
10.
            wbTarget.Worksheets(1).Delete 
11.
    Wend 
12.
    wbTarget.Worksheets(1).Name = "Zusammenfassung" 
13.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear 
14.
    For Each f In fso.GetFolder(CSVPFAD).Files 
15.
        If LCase(Right(f.Name, 3)) = "csv" Then 
16.
            Workbooks.OpenText Filename:=f.Path 
17.
            Set wbSource = ActiveWorkbook 
18.
            On Error Resume Next 
19.
            Set ws = wbTarget.Worksheets(f.Name) 
20.
            If Err <> 0 Then 
21.
                Set ws = wbTarget.Worksheets.Add 
22.
                ws.Name = f.Name 
23.
                ws.Range("A:ZZ").Clear 
24.
            End If 
25.
         
26.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True 
27.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1") 
28.
            wbSource.Close False 
29.
        End If 
30.
    Next 
31.
    Set ts = wbTarget.Worksheets("Zusammenfassung") 
32.
    Dim curCell As Range 
33.
    Set curCell = ts.Range("A1") 
34.
    For i = 1 To wbTarget.Worksheets.Count - 1 
35.
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row 
36.
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column 
37.
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell 
38.
        Set curCell = curCell.End(xlDown).Offset(2, 0) 
39.
    Next 
40.
    Application.DisplayAlerts = True 
41.
    Set fso = Nothing 
42.
End Sub 
43.
 
Allerdings habe ich da noch ein Problem und ein Anliegen, bei dem mir vielleicht einer helfen kann:

Der Import der CSV-Dateien aus einem Ordner in eine Excel Datei klappt sehr gut. Allerdings habe ich noch ein kleines Problem:

aus ursprünglich:

Trendlogs

Timestamp Trend__Archive1
30.01.2014 00:07 190,387
30.01.2014 00:22 190,387
30.01.2014 00:37 190,388
30.01.2014 00:52 190,389
30.01.2014 01:07 190,390
..
..
..

wird folgendes importiert:


Trendlogs

Timestamp Trend__Archive1
30.01.2014 00:07:36 190
30.01.2014 00:22:35 190
30.01.2014 00:37:34 190
30.01.2014 00:52:34 190
30.01.2014 01:07:33 190
..
..
..

Zeilen sind dabei >10000


Bei dem Import über das VBA-Macro wird die wichtige Nachkommastelle des Messwertes abgeschnitten (190,xxx). Durch Umformatierung kann die Nachkommastelle nicht zurückgeholt werden. Wo und wie kann ich das Macro anpassen???

Ich hätte da noch ein zweites Anliegen, bei dem ich ohne Hilfe nicht weiter komme:

Ich habe im Grunde ca. 50 solcher Einzel-Dateien in eine Datei zu importieren. Im Idealfall sollten alle Daten allerdings auf ein Tabellenblatt gelangen und nicht jede Datei ein eigenes Tabellenblatt erhalten. Jede von mir zu importierende Datei hat zwei Spalten (1.Spalte mit Datum und Uhrzeit; 2. Spalte mit Messwert) die immer vollständig zu importieren sind. Der zu importierenden Inhalt der Dateien sollte jeweils in die nächsten freien Spalten gepackt werden:


Dateiname1Spalte A DatumUhrzeitDateiname1Spalte B MesswertDateiname2Spalte C DatumUhrzeitDateiname2Spalte D MesswertDateiname 3Spalte E DatumUhrzeitDateiname 3Spalte F Messwert...

Weiß da jemand von Euch wie ich das anstellen kann???


Ich bin für jeden Tipp/jede Hilfe dankbar!!!

Grüße Markus
Mitglied: 106543
11.03.2014 um 11:07 Uhr
Bitte warten ..
Mitglied: colinardo
LÖSUNG 11.03.2014, aktualisiert 12.03.2014
Danke Dir für deinen Hinweis Exze, hab den Doppel-Thread erst gerade gesehen

Abweichend vom Code im Parallel-Thread, platziert der folgende Code die CSV-Dateien nebeneinander auf dem Sheet: (weitere Hinweise zum Code findest du in deinem ersten Ursprungs-Kommentar)
01.
Sub ImportiereCSVDateien() 
02.
    Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer, fso As Object, f As Object 
03.
    Const CSVPFAD = "E:\csv-dateien" 
04.
    Set fso = CreateObject("Scripting.Filesystemobject") 
05.
    Set ws = Worksheets(1) 
06.
    ws.Range("A:ZZ").Clear 
07.
    Set startRange = ws.Range("A2") 
08.
    Set curRange = startRange 
09.
    Application.DisplayAlerts = False 
10.
 
11.
    For Each f In fso.GetFolder(CSVPFAD).Files 
12.
        If LCase(Right(f.Name, 3)) = "csv" Then 
13.
            importCSV f.Path, ";", curRange, True 
14.
            curRange.Offset(-1, 0).Value = f.Name 
15.
            curRange.Offset(-1, 0).Font.Bold = True 
16.
            Set curRange = curRange.End(xlToRight).Offset(0, 1) 
17.
        End If 
18.
         
19.
    Next 
20.
    Application.DisplayAlerts = True 
21.
    Set fso = Nothing 
22.
End Sub 
23.
 
24.
Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean) 
25.
    Dim fso As Object, regex As Object, patNumber As String, arrLines As Variant, rngCurrent As Range, intStart As Integer, cols As Variant, c As Integer, wert As String, matches As Object, i As Integer 
26.
    Set fso = CreateObject("Scripting.FileSystemObject") 
27.
    Set regex = CreateObject("vbscript.regexp") 
28.
    patNumber = "^([\d\.,\+\-]+)$" 
29.
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare) 
30.
    Set rngCurrent = targetRange 
31.
    If importHeader Then 
32.
        intStart = 0 
33.
    Else 
34.
        intStart = 1 
35.
    End If 
36.
    For i = intStart To UBound(arrLines) 
37.
        If arrLines(i) <> "" Then 
38.
            cols = Split(arrLines(i), delim, -1, vbTextCompare) 
39.
            For c = 0 To UBound(cols) 
40.
                rngCurrent.Offset(0, c).ClearFormats 
41.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare)) 
42.
                ' check for Numberformat 
43.
                regex.Pattern = patNumber 
44.
                Set matches = regex.Execute(wert) 
45.
                If matches.Count > 0 Then 
46.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare) 
47.
                End If 
48.
                ' set value in cell 
49.
                rngCurrent.Offset(0, c).Value = wert 
50.
            Next 
51.
            Set rngCurrent = rngCurrent.Offset(1, 0) 
52.
        End If 
53.
    Next 
54.
    Set fso = Nothing 
55.
    Set regex = Nothing 
56.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: sommer2013
11.03.2014 um 11:49 Uhr
Ich war leider nicht ganz Präzise bei meiner Beschreibung im 2.Teil (Doppel-Thread):

Zur Auswertung wäre für mich folgende Anordnung der importierten Dateien extrem viel besser:


Trendlogs1 Trendlogs2 Trendlogs S3...
Timestamp Messwert1 Timestamp Messdaten 2 Timestamp...
30.01.2014 00:07 309,712 30.01.2014 00:07 190,387 ...
30.01.2014 00:22 309,719 30.01.2014 00:22 190,387 ...
30.01.2014 00:37 309,726 30.01.2014 00:37 190,387 ...
30.01.2014 00:52 309,733 30.01.2014 00:52 190,387 ...

Wow ich bin immer noch platt über die schnelle Reaktion- Danke schon mal an Uwe und Exzellius

Bei dem Code oben bekomme ich noch eine Fehlermeldung 400.

Grüße Markus
Bitte warten ..
Mitglied: colinardo
11.03.2014, aktualisiert um 12:11 Uhr
Zur Auswertung wäre für mich folgende Anordnung der importierten Dateien extrem viel besser:
ist oben angepasst mit den Dateinamen
Zitat von sommer2013:
Bei dem Code oben bekomme ich noch eine Fehlermeldung 400.
Pfad und Trennzeichen, anpassen, siehe anderen Thread ... ansonsten den Code im Debug-Modus schrittweise ausführen ... hier geht es einwandfrei ..

Zur Info: In den CSV-Dateien sollte nur eine Zeile für die Überschrift und die Zeilen für die Werte stehen, sonst nichts, ansonsten muss das Script angepasst werden!

Eventuell hast du oben in deinen Code noch ein Option Explicit stehen, wenn ja, dies mal rauslöschen.
Bitte warten ..
Mitglied: sommer2013
11.03.2014 um 12:19 Uhr
Hallo Uwe,

ich habe das ganze in einzelschritten Durchlaufen. Bei einem Abgespeckten Dateiimport bekomme ich nun die Fehlermeldung Anwendungs- oder objektdefinierter Fehler. Im Ergebnis scheint die Programmierung im folgenden Part hängen zu bleiben.
01.
 
02.
 For i = intStart To UBound(arrLines) 
03.
        If arrLines(i) <> "" Then 
04.
            cols = Split(arrLines(i), delim, -1, vbTextCompare) 
05.
            For c = 0 To UBound(cols) 
06.
                rngCurrent.Offset(0, c).ClearFormats 
07.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare)) 
08.
                ' check for Numberformat 
09.
                regex.Pattern = patNumber 
10.
                Set matches = regex.Execute(wert) 
11.
                If matches.Count > 0 Then 
12.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare) 
13.
                End If 
14.
                ' set value in cell 
15.
                rngCurrent.Offset(0, c).Value = wert 
16.
            Next 
17.
            Set rngCurrent = rngCurrent.Offset(1, 0) 
18.
        End If 
19.
    Next 
20.
 
21.
 
Auf jeden Fall importiert er die erste Datei richtig. Die Spalten und Zeilen der 2. und die folgenden Dateien werden nicht sichtbar importiert. Dort scheint es zu hängen...

Grüße soweit
Bitte warten ..
Mitglied: colinardo
11.03.2014 um 12:26 Uhr
Hier gehts auch mit mehreren Files ohne Probleme, dann muss es mit einem deiner Files zusammenhängen, poste mal die Header und einige Zeilen der Dateien...
Bitte warten ..
Mitglied: sommer2013
11.03.2014 um 12:38 Uhr
Aach wahrscheinlich liegt es an den Kopfzeilen:


Genaue Abfolge der *.csv-Datei aus dem Editor:

Trendlogs Start Datum/Uhrzeit : 30.01.2014 00:00:00 Ende Datum/Uhrzeit : 23.02.2014 23:59:59;
;
Timestamp;Elektrozaehler_Archive
30.01.2014 00:07;190,387
30.01.2014 00:22;190,387
30.01.2014 00:37;190,387
30.01.2014 00:52;190,387
30.01.2014 01:07;190,387
30.01.2014 01:22;190,388
30.01.2014 01:37;190,388
.
.
.

;
;
;
;

oder?
Bitte warten ..
Mitglied: colinardo
11.03.2014, aktualisiert um 12:50 Uhr
Zitat von sommer2013:
Aach wahrscheinlich liegt es an den Kopfzeilen:
oder?
JA, hatte ich aber oben bereits geschrieben, ich passe es dir gleich mal an ..
Bitte warten ..
Mitglied: colinardo
LÖSUNG 11.03.2014, aktualisiert um 13:03 Uhr
in diesem Fall, tausche die untere Funktion durch diese aus (ist nur die Startzeile geändert worden):
01.
Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean) 
02.
    Dim fso As Object, regex As Object, patNumber As String, arrLines As Variant, rngCurrent As Range, intStart As Integer, cols As Variant, c As Integer, wert As String, matches As Object, i As Integer 
03.
    Set fso = CreateObject("Scripting.FileSystemObject") 
04.
    Set regex = CreateObject("vbscript.regexp") 
05.
    patNumber = "^([\d\.,\+\-]+)$" 
06.
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare) 
07.
    Set rngCurrent = targetRange 
08.
    If importHeader Then 
09.
        intStart = 2 
10.
    Else 
11.
        intStart = 3 
12.
    End If 
13.
    For i = intStart To UBound(arrLines) 
14.
        If arrLines(i) <> "" Then 
15.
            cols = Split(arrLines(i), delim, -1, vbTextCompare) 
16.
            For c = 0 To UBound(cols) 
17.
                rngCurrent.Offset(0, c).ClearFormats 
18.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare)) 
19.
                ' check for Numberformat 
20.
                regex.Pattern = patNumber 
21.
                Set matches = regex.Execute(wert) 
22.
                If matches.Count > 0 Then 
23.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare) 
24.
                End If 
25.
                ' set value in cell 
26.
                rngCurrent.Offset(0, c).Value = wert 
27.
            Next 
28.
            Set rngCurrent = rngCurrent.Offset(1, 0) 
29.
        End If 
30.
    Next 
31.
    Set fso = Nothing 
32.
    Set regex = Nothing 
33.
End Function
und das nächste mal solchen Inhalt bitte mit Tags posten. Danke.
Bitte warten ..
Mitglied: sommer2013
11.03.2014 um 12:58 Uhr
Große Weltklasse!!!

Es geht! Tausend Dank!
Bitte warten ..
Mitglied: 106543
11.03.2014 um 13:01 Uhr
Dann markier das Ganze doch bitte auch als gelöst
Info hier: http://www.administrator.de/faq/32

Grüße
Exze
Bitte warten ..
Mitglied: jonnny
10.05.2015 um 17:34 Uhr
Hallo Forum,
hallo Uwe

vielen Dank für dein Skript!
Ich habe gehofft, es selbst hin zu bekommen, schaffe es aber leider nicht...
Zwei Anpassungen würde ich benötigen:
Jeden Wert in der ersten Spalte möchte ich vom UNIX-Zeitformat umrechnen und als Datum formatieren. Nach meinem Empfinden müsste das so funktionieren: wert = (wert + 7200) / 86400 + 25569 Das geht so aber leider nicht.
In die zweite Spalte soll wieder der Wert der ersten Spalte geschrieben werden, diesmal als Uhrzeit formatiert. Alle weiteren Spalten müssen demnach eine Spalte weiter nach rechts verschoben werden.

Vielleicht kann mir dabei jemand helfen?

Sonnige Grüße
Jonny
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen - Datumsformat weg??
gelöst Frage von br-mv2014Microsoft Office9 Kommentare

Hallo allerseits, ich bin neu hier, versuche mich nur gelegentlich in vba-progrämmchen und war erfreut hier unter "Alle CSV-Dateien ...

Microsoft Office
Alle CSV-Dateien mit neuem Datum in einem Ordner mit einem VBA Makro einlesen
Frage von parlermo2102Microsoft Office1 Kommentar

Hallo ich habe ein Problem Mit Makro ich möchte 2 CSV dateien per Makro einlesen SetMontageExport-DGS-16-04-11.csv SetMontageExport-NDGS-16-04-11.csv wie bekomme ...

VB for Applications
Mehrere CSV-Dateien mit einem VBA Makro einlesen und automatisch verarbeiten
Frage von armini92VB for Applications3 Kommentare

Hallo! Ich schreibe gerade meine Bachelorarbeit und bekomme täglich zahlreiche Messergebnisse im CSV-Format ausgegeben. Diese muss ich manuell konvertieren, ...

Microsoft Office
Csv datei vba makro excel einlesen leicht anpassen - eventuell noch eine Erweiterung
Frage von mrniceguy1977Microsoft Office2 Kommentare

Hallo Zusammen, bin neu bei euch und durch die Suche nach einem CSV Importer auf diese Seite gestossen. Den ...

Neue Wissensbeiträge
Datenschutz

Teamviewer kommt für IoT-Geräte wie den Raspberry Pi

Information von magicteddy vor 3 StundenDatenschutz

Moin, jetzt werden IoT Geräte endgültig zur Wanze? Anscheinend kann man auf einem Dashboard seine Geräte visualisieren Ich stelle ...

Microsoft

Letzte Updates für Win10 und Server2016 müssen bei Bedarf über den Update catalogue in den WSUS importiert werden!

Tipp von DerWoWusste vor 8 StundenMicrosoft1 Kommentar

automatisch kommt da nichts an im WSUS und auch nicht im SCCM. Siehe Hinweise zum Bezug der jeweils neuesten ...

Linux

Meltdown und Spectre: Linux Update

Information von Frank vor 3 TagenLinux

Meltdown (Variante 3 des Prozessorfehlers) Der Kernel 4.14.13 mit den Page-Table-Isolation-Code (PTI) ist nun für Fedora freigegeben worden. Er ...

Tipps & Tricks

Solutio Charly Updater Fehlermeldung: Das Abgleichen der Dateien in -Pfad- mit dem Datenobject ist fehlgeschlagen

Tipp von StefanKittel vor 3 TagenTipps & Tricks

Hallo, hier einmal als Tipp für alle unter Euch die mit der Zahnarztabrechnungssoftware Charly von Solutio zu tun haben. ...

Heiß diskutierte Inhalte
Netzwerkmanagement
Preis für Wartungsvertrag ok?
gelöst Frage von a-za-zNetzwerkmanagement21 Kommentare

Hallo! Mal ne Frage, weil ich mich mit dem akzeptablen Preis für einen Reaktionszeitvertrag nicht auskenne. Meine Firma hat ...

Windows Netzwerk
Ist ein Portforwarding auf einen PC ohne lauschendes Programm ein (großes) Sicherheitsproblem?
Frage von PluwimWindows Netzwerk13 Kommentare

Hallo zusammen, zur Fernwartung eines Rechners an einem anderen Ort nutze ich VNC. Da dieser Rechner einfach nur eine ...

SAN, NAS, DAS
Wer kennt sich mit QNAP und CISCO aus ?
gelöst Frage von MachelloSAN, NAS, DAS10 Kommentare

Hallo Zusammen hier im Forum, Ich habe ein QNas 451+ und dieses NAS hat zwei GBit Lan Adapter die ...

Windows Server
Terminal Server 2016 erkennt Berechtigungen nicht
gelöst Frage von Thomas2Windows Server10 Kommentare

Hallo Administratoren, folgendes Problem stellt sich dar: Es gibt zwei Windows Server 2016, die als Terminal Server fungieren. Jetzt ...