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, 1796 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 ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

(1)

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
VB for Applications
gelöst VBA - viele CSV Dateien in ein Excel sheet (2)

Frage von LordY6 zum Thema VB for Applications ...

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

Frage von parlermo2102 zum Thema Microsoft Office ...

Batch & Shell
gelöst 2 Csv -Dateien zum Teil zusammenfügen (6)

Frage von Piotrney zum Thema Batch & Shell ...

Batch & Shell
Mehrere.csv Dateien zusammenfügen zu einer Datei mit bat (4)

Frage von Piotrney zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (14)

Frage von JayyyH zum Thema Switche und Hubs ...

DSL, VDSL
DSL-Signal bewerten (13)

Frage von SarekHL zum Thema DSL, VDSL ...

Windows Server
Mailserver auf Windows Server 2012 (9)

Frage von StefanT81 zum Thema Windows Server ...