Datenimport automatisieren
sebastian
ich versuche gerade ein Makro zu erstellen, das mir beim Import von Daten aus ca. 150 .txt Dateien hilft.
Die Dateien haben alle den selben Dateinamen, der sich am Ende durch den Zusatz jjjj-mm unterscheidet.
Also : Dateiname_1997-01
Dateiname_1997-02
...
Dateiname_2010-12
Die Daten sind durch Komma getrennt und das Dezimalzeichen ist der Punkt.
Aus diesen Dateien Möchte ich die Daten aus Spalte S ab der 7. Zeile bis zum vorletzten gefüllten Element der Spalt kopieren und in einem geöffneten Arbeitsblatt untereinander einfügen.
Es sind immer so viele Werte wie der jeweilige Monat Tage hat. Ein Zusätzlicher Wert am Ende der Spalte gibt den Mittelwert der vorangegangenen Werte an und soll nicht berücksichtigt werden.
Bisher habe ich mir ein Makro mit dem Makrorecorder erstellt, indem ich den Prozess für 1 Jahr manuell erstellt habe und für die folgenden Jahre mit der "suchen und ersetzen" Funktion die Jahreszahl 1997 durch 1998 im Makro ersetzt habe.
Das spart zwar schon viel Zeit, ist aber noch nicht ganz optimal und hat auch in Schaltjahren einen kleinen Fehler ;-)
Bisheriges Makro:
Sub Datenimport()
' Datenimport Makro
Workbooks.OpenText Filename:= _
"C:\Pfad\Dateiname_1997-01.txt" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array( _
1, 1), Array(2, 1)), DecimalSeparator:=".", TrailingMinusNumbers:=True
Range("S7:S37").Select
Selection.Copy
Windows("Arbeitsblatt.xls").Activate
Range("D6").Select
ActiveSheet.Paste
Windows("Dateiname_1997-01.txt").Activate
ActiveWindow.Close
Workbooks.OpenText Filename:= _
"C:\Pfad\Dateiname_1997-02.txt" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array( _
1, 1), Array(2, 1)), DecimalSeparator:=".", TrailingMinusNumbers:=True
Range("S7:S34").Select
Selection.Copy
Windows("Arbeitsblatt.xls").Activate
Range("D37").Select
ActiveSheet.Paste
Windows("Dateiname_1997-02.txt").Activate
ActiveWindow.Close
Workbooks.OpenText Filename:= _
"C:Pfad\Dateiname_1997-03.txt" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array( _
1, 1), Array(2, 1)), DecimalSeparator:=".", TrailingMinusNumbers:=True
Range("S7:S37").Select
Selection.Copy
Windows("Arbeitsblatt.xls").Activate
Range("D65").Select
ActiveSheet.Paste
Windows("Dateiname_1997-03.txt").Activate
ActiveWindow.Close
End Sub
Nun hätte ich gerne ein Makro, das mir die Arbeit für alle Dateien auf einmal abnimmt.Ich hoffe ich konnte mein Problem verständlich vermitteln, sonst beantworte ich gerne genauere Fragen dazu.
Würde mich sehr freuen, wenn jemand einen passenden Ansatz für mich parat hat :)
Vielen Dank schon mal im Voraus für alle Antworten.
Grüße
Sebastian