Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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
GELÖST

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

Frage Entwicklung VB for Applications

Mitglied: sommer2013

sommer2013 (Level 1) - Jetzt verbinden

11.03.2014, aktualisiert 11:11 Uhr, 4604 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
Alle CSV-Dateien mit neuem Datum in einem Ordner mit einem VBA Makro einlesen (1)

Frage von parlermo2102 zum Thema Microsoft Office ...

VB for Applications
gelöst Mehrere CSV Dateien aus verschiedenen Ordner einlesen via VBA (12)

Frage von mtufangil zum Thema VB for Applications ...

Microsoft Office
gelöst CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen (5)

Frage von JoSiBa zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...