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
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, 2430 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
Batch & Shell
CSV-Datei nach Excel importieren
Frage von mrvfbnummer2Batch & Shell5 Kommentare

Hallo Leute, ich möchte CSV-Dateien in eine Excel-Datei mit PowerSell importieren. Ich habe bereits viel ausprobiert aber habe noch ...

VB for Applications
Excel Makro zum Suchen von Spalten und exportieren in CSV
Frage von RaptoxVB for Applications3 Kommentare

Hallo Zusammen Ich bin nun seit längerem daran beschäftigt in Excel 2013 ein Makro zu basteln, welches folgendes erledigt: ...

VB for Applications
Mittels VBA Makro Excel Zellen auslesen und diese in eine CSV Datei exportieren
gelöst Frage von windowskidVB for Applications3 Kommentare

Hallo zusammen ich möchte gerne ein Makro schreiben, welches eine Zeile auf Inhalt überprüft und falls etwas drin steht, ...

Microsoft Office
CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen
gelöst Frage von JoSiBaMicrosoft Office5 Kommentare

Hallo zusammen, ich benutze folgenden Code von Colinardo: Die Importierung an sich Funktioniert. Ich habe hier nur 4 Anliegen. ...

Neue Wissensbeiträge
MikroTik RouterOS

Mikrotik - Lets Encrypt Zertifikate mit MetaROUTER Instanz auf dem Router erzeugen

Anleitung von colinardo vor 11 StundenMikroTik RouterOS4 Kommentare

Einleitung Folgende Anleitung ist aus der Lage heraus entstanden das ein Kunde auf seinem Mikrotik sein Hotspot Captive Portal ...

Sicherheit

Sicherheitslücke in HP-Druckern - Firmware-Updates stehen bereit

Information von BassFishFox vor 11 StundenSicherheit

Ein weiterer Grund, dass Drucker keinerlei Verbindung nach "auswaerts" haben sollen. Unter Verwendung spezieller Malware können Angreifer aus der ...

Administrator.de Feedback

Entwicklertagebuch: Die Startseite wurde überarbeitet

Information von admtech vor 14 StundenAdministrator.de Feedback9 Kommentare

Hallo Administrator User, mit dem Release 5.7 haben wir unsere Startseite überarbeitet und die Beiträge und Fragen voneinander getrennt. ...

Vmware

VMware Desktopprodukte sind verwundbar

Information von Penny.Cilin vor 18 StundenVmware

Die VMware-Anwendungen zum Umgang mit virtuellen Maschinen Fusion, Horizon Client und Workstation sowie die Plattform NSX sind verwundbar. Davon ...

Heiß diskutierte Inhalte
Visual Studio
Vb.net-Tool zum Erzeugen einer Outlook-E-Mail
Frage von ahstaxVisual Studio24 Kommentare

Hallo, ich möchte gerne ein vb.net-Tool schreiben, das am Ende eine Outlook-E-Mail erzeugt. Grundsätzlich ist mir klar, wie das ...

Windows Server
RDP macht Server schneller???
Frage von JaniDJWindows Server16 Kommentare

Hallo Community, wir betrieben seit geraumer Zeit diverse virtuelle Maschinen und Server mit Windows Server 2012. Leider haben wir ...

Windows Netzwerk
Netzwerk Neustrukturierung
Frage von IT-DreamerWindows Netzwerk16 Kommentare

Hallo verehrte Community und Admins, bei uns im Haus steht eine Neustrukturierung an. Dafür benötige ich von euch ein ...

Windows 10
Windows 10 dunkler Bildschirm nach Umfallen
Frage von AkcentWindows 1015 Kommentare

Hallo, habe hier einen Windows 10 Rechner der von einem User umgefallen wurde (Beine übers Knie, an den PC ...