Excel. CSV Import über Makro.

[Shypo]

Hallo,

hab google schon genutzt aber genau die Lösung die ich suchen finde ich nicht. Entweder finde ich Makros die für jeden CSV Datei eine Tabelle anlegen oder es kommt eine Fehlermeldung. Mir ist das auch zu kompliziert ein Makro zu schreiben. Ich check das nicht

Deswegen meine Frage. Habe eine Excel Datei. Und 365 bzw. 366 CSV Dateien. Also jeden Tag eine.

In der CSV Datei vom ersten steht:
A9 = 01.01.2017 00:00
A10 = 01.01.2017 00:05
usw. bis
A296 = 01.01.2017 23:55

In der CSV Datei vom zweiten steht steht:
A9 = 02.01.2017 00:00
A10 = 02.01.2017 00:05
usw. bis
​A296 = 02.01.2017 23:55

In den entsprechenden B bis E Spalten stehen dann die Werte.

In dieser eine Excel Datei bzw. einen Tabelle soll die Spalten A-E der CSV Dateien übernommen werden. Je doch sollte die Zeilen fortlaufend gefüllt werden. Sprich A1-A288 = 1 Januar, A289-A576 = 2 Januar usw. bis 31 Dezember.
Heißt ich hätte insgesamt 12 Zeilen Pro Stunde = 288 Zeilen pro Tag = 105120 Zeilen pro Jahr.

Die CSV Dateien haben folgenden Namen:
"Auswertung-20170101"
"Auswertung-20170102"
.....
"Auswertung-20171231"
liegen aber alle in einem Ordner, zumindest dann wenn das Jahr zu Ende ist .

Habe als erstes mit Hyperlinks gearbeitet und versucht diese "zu ziehen" Excel kapiert das aber nicht.
Dann mit folgendem Makro, jetzt habe ich sozusagen 365 Tabellen in einer Datei.

[COLOR=#006699][FONT=Courier]Option Explicit [/FONT][/COLOR]

[COLOR=#006699][FONT=Courier]Sub x() [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   Dim fd As FileDialog [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   Dim strFolder As String [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   Dim strName As String [/FONT][/COLOR]

[COLOR=#006699][FONT=Courier]   Set fd = Application.FileDialog(msoFileDialogFolderPicker) [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   If fd.Show <> -1 Then Exit Sub [/FONT][/COLOR]

[COLOR=#006699][FONT=Courier]   strFolder = fd.SelectedItems(1) & "\" [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   strName = Dir(strFolder & "*.csv") [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   While Len(strName) > 0 [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]      Workbooks.OpenText Filename:=strFolder & strName, Local:=True [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]      Rows(1).Delete [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]      ActiveSheet.UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]      ActiveWorkbook.Close False [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]      strName = Dir [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]   Wend [/FONT][/COLOR]
[COLOR=#006699][FONT=Courier]End Sub [/FONT][/COLOR]

Vielleicht hat jemand so ein Makro und könnte mir das zur Verfügung stellen, aber ich glaube nicht das das geht mit Zeilen und Spalten auswählen.

Vielen Dank!

Gruß

 

[diamdomi]

Es ist definitiv möglich mich VBA, sowas ähnliches habe ich schon bei der Arbeit gemacht. Habe aber leider keine Dateien zur Verfügung.

 

[cumulonimbus8]

Meine Strategie wäre folgende; angenommen, dass alle CSVs nicht noch geprüft werden müssen.

1. Per Schleife die CSVs ablaufen und als Datei öffnen
2. CSV zeilenweise lesen - direkt als ganze Zeile
3. Zeile splitten und auf Spalten verteilen
4. Mittels globalem Zähler Zeile für Zeile ins Blatt schreiben

CN8

 

[GunMum]

Das hört sich so an, als ob das mit Power Query -> http://www.excel-ist-sexy.de/power-query-das-add-in/ relativ leicht lösbar ist. Eine kleine Muster-Sammlung (2-3) der *.csv und einige Muster-Zeilen des Wunsch-Ergebnisses könnten helfen.

 

[Shypo]

Vielen Dank für die ganzen Antworten.

Hatte heute mal wieder etwas Zeit und habe folgendes gefunden:

Sub CSV()
'(C) Ramses
'Liest alle CSV-Dateien in einem Verzeichnis ein
Dim Datei As String, freeRow As Long
Dim Qe As Integer
Dim PFAD As String
PFAD = "C:\Users\Shypo\Desktop\CSV\" 'ACHTUNG: Bachslash am Schluss
Datei = Dir(PFAD & "*.csv")
Qe = MsgBox("Zum Import muss die aktuelle Tabelle leer sein," & vbCrLf & _
    "bzw. alle Daten der aktuellen Tabelle: "" " & ActiveSheet.Name & " "" werden gelöscht", _
    vbYesNo + vbCritical, "CSV-Import starten ?")
If Qe = vbNo Then
    MsgBox "CSV-Import abgebrochen"
    Exit Sub
Else
    Cells.Clear
End If
Do While Datei <> ""
    freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & PFAD & Datei, Destination:=Range("A" & freeRow))
        .Name = Datei
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Datei = Dir()
Loop
End Sub

Quelle http://www.herber.de/forum/archiv/820to824/t822222.htm

Das funktioniert auch, jetzt muss ich nur noch hinbekommen, das nur A9 bis E296 eingelesen werden.
Hab schon an der Range gespielt, jetzt schreibt er alles nebeneinander.

Hat noch jemand eine Idee?

Danke

​Gruß Shypo

 

[simpsonsfan]

Schau dir mal Zeilen 34 und 42 an. Dort müsstest du den Start aif Zeile 9 der CSVs legen (bis zum Ende) und ich vermute, wenn du in Zeile 42 nur 5 Spalten einträgst, werden auch nur fünf ausgelesen.
Alternativ kannst du auch die Dateien normal öffnen (also in eine temporäre Tabelle importieren), mit Range("A9:E296") den gewünschten Bereich markieren, in die neue Tabelle einfügen und das temporäre Blatt schließen. Könnte möglicherweise etwas schlechter performen, ich weiß nicht, wie schnell QueryTables ist.

 

[Shypo]

DANKE! funktioniert, und läuft jetzt auch viel schneller

 

[simpsonsfan]

Freut mich. Wie hast du es jetzt gelöst? Nach wie vor mit QueryTables? Und dann ist es einfach schneller, weil jetzt weniger Daten verarbeitet werden?

 

[Shypo]

​So wie du gesagt hast. Zeile 34 und 42 angepasst.