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

Excel Makro um CSV Dateien auszuwerten und gesammelt anzuzeigen.

Frage Entwicklung VB for Applications

Mitglied: diosinc

diosinc (Level 1) - Jetzt verbinden

22.12.2014, aktualisiert 11:40 Uhr, 2105 Aufrufe, 5 Kommentare

Hallo zusammen,

ich habe hier im Forum ein VBA Script gefunden, welches ich gerne anpassen würde
leider sind meine VBA Kenntnisse nur minimal und hoffe das mir hier einer von euch
helfen kann.

Zunächst wurde ich gerne die CONST "csvpfad" mit der Variable aus der Ordnerauswahl
"strOrnder" füllen, dies ist leider nicht möglich? - Hat hier einer eine Idee?

Des Weiteren würde ich gerne nur Einträge aus den CSV Dateien anzeigen die in der zweiten
Spalte ein "failed" als Wert besitzen. Besteht die Möglichkeit das innerhalb des Makros
so durchzuführen?

Hier das Makro:

01.
Sub ImportiereCSVDateien() 
02.
 
03.
Dim strOrdner As String 
04.
 
05.
    With Application.FileDialog(msoFileDialogFolderPicker) 
06.
        .InitialFileName = "C:\" 
07.
        .Title = "Ordnerauswahl" 
08.
        .ButtonName = "Auswahl..." 
09.
        .InitialView = msoFileDialogViewList 
10.
        If .Show = -1 Then 
11.
            strOrdner = .SelectedItems(1) 
12.
            If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\" 
13.
          Else 
14.
            strOrdner = "" 
15.
        End If 
16.
    End With 
17.
 
18.
    Const csvpfad = "D:\csv\20141219_007" 
19.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, curCell As Range 
20.
    Set fso = CreateObject("Scripting.Filesystemobject") 
21.
    Set wbTarget = ThisWorkbook 
22.
    Application.DisplayAlerts = False 
23.
    Application.ScreenUpdating = False 
24.
    'Lösche alle Worksheets bevor wir alle neu anlegen 
25.
    While wbTarget.Worksheets.Count > 1 
26.
        wbTarget.Worksheets(1).Delete 
27.
    Wend 
28.
    wbTarget.Worksheets(1).Name = "Zusammenfassung" 
29.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear 
30.
    For Each f In fso.GetFolder(csvpfad).Files 
31.
       If LCase(fso.GetExtensionName(f.Name)) = "csv" Then 
32.
            Workbooks.OpenText Filename:=f.Path 
33.
            Set wbSource = ActiveWorkbook 
34.
            On Error Resume Next 
35.
            Set ws = wbTarget.Worksheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count)) 
36.
            ws.Name = f.Name 
37.
            ws.Range("A:ZZ").Clear 
38.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True 
39.
            wbSource.Worksheets(1).UsedRange.Copy Destination:=ws.Range("A1") 
40.
            wbSource.Close False 
41.
        End If 
42.
    Next 
43.
     
44.
    With wbTarget.Worksheets("Zusammenfassung") 
45.
        Set curCell = .Range("B1") 
46.
        For i = 2 To wbTarget.Worksheets.Count 
47.
            'Inhalt der CSV in das Zusammenfassungs-Sheet kopieren 
48.
            wbTarget.Sheets(i).UsedRange.Copy Destination:=curCell 
49.
            'Name der Quelle in Spalte A schreiben 
50.
            curCell.Offset(0, -1).Value = wbTarget.Sheets(i).Path 
51.
            'Zelle für nächsten Import setzen 
52.
            Set curCell = curCell.Offset(wbTarget.Sheets(i).UsedRange.Rows.Count + 2, 0) 
53.
        Next 
54.
        'Spaltengröße im Zusammenfassungssheet automatisch anpassen 
55.
        .UsedRange.EntireColumn.AutoFit 
56.
        .Select 
57.
    End With 
58.
    Application.DisplayAlerts = True 
59.
    Application.ScreenUpdating = True 
60.
    MsgBox "Importvorgang erfolgreich durchgeführt.", vbInformation 
61.
    Set fso = Nothing 
62.
End Sub
Für eure Hilfe bedanke ich mich schon jetzt.
Mitglied: colinardo
23.12.2014, aktualisiert um 15:00 Uhr
Hallo diosinc,
habe dir hier mal ein Demo-Sheet gebaut, der Code vom ursprünglichen Beitrag ist nicht mehr ganz aktuell bzw. nicht mehr Up-to-Date wie man so schön sagt. Der neue ist wesentlich schneller und aufgeräumter:
ImportCSV_258309.xlsm

01.
Sub ImportCSVFromFolder() 
02.
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String 
03.
     
04.
    With Application.FileDialog(msoFileDialogFolderPicker) 
05.
        .InitialFileName = "C:\" 
06.
        .Title = "Ordnerauswahl" 
07.
        .ButtonName = "Auswahl..." 
08.
        .InitialView = msoFileDialogViewList 
09.
        If .Show = -1 Then 
10.
            CSVPFAD = .SelectedItems(1) 
11.
        Else 
12.
            Exit Sub 
13.
        End If 
14.
    End With 
15.
     
16.
    'Legt das CSV-Trennzeichen für die Dateien fest 
17.
    strCSVDelimiter = ";" 
18.
     
19.
    Set fso = CreateObject("Scripting.Filesystemobject") 
20.
    Application.DisplayAlerts = False 
21.
    Application.ScreenUpdating = False 
22.
     
23.
    'Zielarbeitsblatt für die importierten Daten 
24.
    Set wsTarget = Worksheets(1) 
25.
    wsTarget.Name = "Zusammenfassung" 
26.
    'temporäres Arbeitsblatt für den Import der Daten erstellen 
27.
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 
28.
     
29.
    'Inhalt des Zusammenfassungsblattes löschen 
30.
    wsTarget.UsedRange.Clear 
31.
     
32.
    'Startausgabezelle festlegen 
33.
    Set curCell = wsTarget.Range("A1") 
34.
    For Each f In fso.GetFolder(CSVPFAD).Files 
35.
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then 
36.
            'Temporäres Sheet löschen 
37.
            wsTemp.UsedRange.Clear 
38.
            'CSV-Daten in Temporäres Sheet importieren 
39.
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1")) 
40.
                .Name = "import" 
41.
                .FieldNames = True 
42.
                .AdjustColumnWidth = True 
43.
                .RefreshPeriod = 0 
44.
                .TextFilePlatform = xlWindows 
45.
                .TextFileStartRow = 1 
46.
                .TextFileParseType = xlDelimited 
47.
                .TextFileTextQualifier = xlTextQualifierDoubleQuote 
48.
                .TextFileOtherDelimiter = strCSVDelimiter 
49.
                .Refresh BackgroundQuery:=False 
50.
                .Delete 
51.
            End With 
52.
             
53.
            With wsTemp 
54.
                'Daten in Zielsheet kopieren 
55.
                .UsedRange.Copy curCell 
56.
            End With 
57.
            'Ausgabezeile eins nach unten schieben 
58.
            Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1) 
59.
        End If 
60.
    Next 
61.
    'Temporäres Sheet löschen 
62.
    wsTemp.Delete 
63.
    'Spalten anpassen 
64.
    wsTarget.Columns.AutoFit 
65.
     
66.
    Application.DisplayAlerts = True 
67.
    Application.ScreenUpdating = True 
68.
    MsgBox "Vorgang beendet!", vbInformation 
69.
    Set fso = Nothing 
70.
End Sub
Als CSV-Trennzeichen ist im Moment das Semikolon(;) angegeben, das kannst du im Code in Zeile 17 ändern.

Grüße Uwe
Bitte warten ..
Mitglied: diosinc
23.12.2014 um 14:30 Uhr
Hallo Uwe,

super vielen Dank.

Leider erhalte ich nach der Ordnerauswahl (hier sind 6 CSV Dateien drin) den Fehler "Laufzeitfehler: 7 - Nicht genügend Speicher".
Das hatte mit der altern Version problemlos funktioniert. (Mein Rechner hat 8 GB RAM, daran sollte es auch nicht hängen)

Hast du vielleicht noch eine Idee?

Zusätzlich noch eine Frage: besteht die Möglichkeit den Inhalt der CSV Dateien noch zu Filtern? Also: z.B. wenn das CSV so aussehen würde:

xp0101001;OK;2014-12-19T10:33:16;
xp0101002;FEHLER;2014-12-19T10:33:16;
xp0101003;OK;2014-12-19T10:33:16;

Das in der Excel Ausgabe nur die Einträge mit "FEHLER" angezeigt werden würden?

Vielen Dank

Gruss
Bitte warten ..
Mitglied: colinardo
LÖSUNG 23.12.2014, aktualisiert 28.12.2014
Zitat von diosinc:
Leider erhalte ich nach der Ordnerauswahl (hier sind 6 CSV Dateien drin) den Fehler "Laufzeitfehler: 7 - Nicht genügend
Speicher".
kann ich hier leider nicht nachvollziehen. Der Code funktionierte bisher immer. Denke da hat Excel irgendein Problem mit einer deiner CSV-Dateien. Da müsstest du mir mal deine CSV-Files schicken (melde dich via PM dann schick ich dir meine Mailadresse)

Eventuell haben deine Files ein anderes Zeichenformat, das lässt sich in Zeile 44 festlegen.

Speichere dein Sheet auch noch mal erneut unter anderem Namen ab.

Zusätzlich noch eine Frage: besteht die Möglichkeit den Inhalt der CSV Dateien noch zu Filtern? Also: z.B. wenn das CSV
Das in der Excel Ausgabe nur die Einträge mit "FEHLER" angezeigt werden würden?
lässt sich machen, dazu änderst du folgenden Abschnitt (Zeile 53-56 des obigen Codes) so ab.
01.
With wsTemp 
02.
     'Daten nach dem Wort "FEHLER" in der zweiten SPALTE der CSV filtern und in Zielsheet kopieren 
03.
     .UsedRange.AutoFilter 
04.
     .UsedRange.AutoFilter Field:=2, Criteria1:="FEHLER" 
05.
     .UsedRange.SpecialCells(xlCellTypeVisible).Copy curCell 
06.
End With
In diesem Fall setze ich Überschriften in jeder CSV-Datei voraus, andernfalls müssen noch zusätzlich Kleinigkeiten angepasst werden.

Mit diesem Code werden deine Daten jeweils einmal nach FAILED und OK in der zweiten Spalte gefiltert und dann in zwei unterschiedliche Sheets kopiert. (Deine CSV-Dateien haben keine Übeschriften, das wurde berücksichtigt)

01.
Sub ImportCSVFromFolder() 
02.
    Dim wsTemp As Worksheet, wsOK As Worksheet, wsFailed As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String 
03.
     
04.
    With Application.FileDialog(msoFileDialogFolderPicker) 
05.
        .InitialFileName = "C:\" 
06.
        .Title = "Ordnerauswahl" 
07.
        .ButtonName = "Auswahl..." 
08.
        .InitialView = msoFileDialogViewList 
09.
        If .Show = -1 Then 
10.
            CSVPFAD = .SelectedItems(1) 
11.
        Else 
12.
            Exit Sub 
13.
        End If 
14.
    End With 
15.
     
16.
    'Legt das CSV-Trennzeichen für die Dateien fest 
17.
    strCSVDelimiter = ";" 
18.
     
19.
    Set fso = CreateObject("Scripting.Filesystemobject") 
20.
    Application.DisplayAlerts = False 
21.
    Application.ScreenUpdating = False 
22.
     
23.
    'Zielarbeitsblätter (OK/FAILED) vorbereiten 
24.
    For Each ws In Worksheets 
25.
        If ws.Name = "OK" Then Set wsOK = ws 
26.
        If ws.Name = "FAILED" Then Set wsFailed = ws 
27.
    Next 
28.
    If wsOK Is Nothing Then 
29.
        Set wsOK = Worksheets.Add 
30.
        wsOK.Name = "OK" 
31.
    End If 
32.
    If wsFailed Is Nothing Then 
33.
        Set wsFailed = Worksheets.Add 
34.
        wsFailed.Name = "FAILED" 
35.
    End If 
36.
     
37.
    'temporäres Arbeitsblatt für den Import der Daten erstellen 
38.
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 
39.
     
40.
    For Each f In fso.GetFolder(CSVPFAD).Files 
41.
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then 
42.
            With wsTemp 
43.
                'AutoFilter deaktivieren 
44.
                .AutoFilterMode = False 
45.
                'Temporäres Sheet löschen 
46.
                .UsedRange.Clear 
47.
                'Dummyüberschrift für den Filter 
48.
                .Range("A1").Value = "Dummyüberschrift" 
49.
                'CSV-Daten in Temporäres Sheet importieren 
50.
                With .QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=.Range("$A$2")) 
51.
                    .Name = "import" 
52.
                    .FieldNames = False 
53.
                    .AdjustColumnWidth = True 
54.
                    .RefreshPeriod = 0 
55.
                    .TextFilePlatform = 1252 
56.
                    .TextFileStartRow = 1 
57.
                    .TextFileParseType = xlDelimited 
58.
                    .TextFileTextQualifier = xlTextQualifierNone 
59.
                    .TextFileOtherDelimiter = strCSVDelimiter 
60.
                    .Refresh BackgroundQuery:=False 
61.
                    .Delete 
62.
                End With 
63.
                 
64.
                'Daten nach dem Wort "FAILED" in der zweiten SPALTE der CSV filtern und in Zielsheet "FAILED" kopieren 
65.
                .UsedRange.AutoFilter 
66.
                .UsedRange.AutoFilter Field:=2, Criteria1:="FAILED" 
67.
                .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsFailed.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
68.
                 
69.
                'Daten nach dem Wort "OK" in der zweiten SPALTE der CSV filtern und in Zielsheet "OK" kopieren 
70.
                .UsedRange.AutoFilter Field:=2, Criteria1:="OK" 
71.
                .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy wsOK.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
72.
            End With 
73.
        End If 
74.
    Next 
75.
    'Temporäres Sheet löschen 
76.
    wsTemp.Delete 
77.
    'Spalten anpassen 
78.
    wsOK.Columns.AutoFit 
79.
    wsFailed.Columns.AutoFit 
80.
     
81.
    Application.DisplayAlerts = True 
82.
    Application.ScreenUpdating = True 
83.
    MsgBox "Vorgang beendet!", vbInformation 
84.
    Set fso = Nothing 
85.
End Sub
Bitte warten ..
Mitglied: colinardo
27.12.2014 um 12:05 Uhr
Wenns das dann war, den Beitrag bitte noch auf gelöst setzen. Merci.
Bitte warten ..
Mitglied: Nik0laus
21.10.2016 um 15:03 Uhr
Das liest sich alles schon sehr nach dem, was ich suche, nur bekomme ich es nicht selber angepasst:
Ich möchte alle txt Dateien aus einem Ordner in eine Excel Tabelle nebeneinander einfügen. Dabei reicht mir eine Registerkarte aus.
In den txt Dateien liegen steht pro Zeile eine Zahl mit einem Komma als Dezimaltrennzeichen.
Falls das mit txt dateien nicht möglich ist, wäre es auch möglich diese txt Dateien als csv zu speichern
Bitte warten ..
Ähnliche Inhalte
VB for Applications
Excel Makro zum Suchen von Spalten und exportieren in CSV (3)

Frage von Raptox zum Thema VB for Applications ...

VB for Applications
Fusszeile mit PageSetup mit VBA in Excel Makro funktioniert nicht? (5)

Frage von HerrHart zum Thema VB for Applications ...

Batch & Shell
gelöst Auslesen und Vergleichen Zweiter CSV Dateien Powershell (7)

Frage von Hainoon zum Thema Batch & Shell ...

Neue Wissensbeiträge
Windows 10

Windows 8.x oder 10 Lizenz-Key aus dem ROM auslesen mit Linux

(6)

Tipp von Lochkartenstanzer zum Thema Windows 10 ...

Tipps & Tricks

Wie Hackt man sich am besten in ein Computernetzwerk ein

(38)

Erfahrungsbericht von Herbrich19 zum Thema Tipps & Tricks ...

Heiß diskutierte Inhalte
Windows 10
gelöst Windows 10 Home "Netzlaufwerk nicht bereit" (19)

Frage von Oggy01 zum Thema Windows 10 ...

Exchange Server
Exchange Postfach leeren - nicht löschen (11)

Frage von AndreasOC zum Thema Exchange Server ...

SAN, NAS, DAS
+100tb Storagelösung (11)

Frage von Data-Fabi zum Thema SAN, NAS, DAS ...

LAN, WAN, Wireless
Cisco W-Lan Controller als Applicance oder Software (11)

Frage von Herbrich19 zum Thema LAN, WAN, Wireless ...