Microsoft Excel

Herbers Excel/VBA-Archiv

txt-Dateien in Excel importieren per Makro


Betrifft: txt-Dateien in Excel importieren per Makro von: Andie
Geschrieben am: 10.08.2016 10:45:19

Hallo Zusammen,

ich bin noch ein ziemlicher Anfänger was das Erstellen von Makros in Excel angeht und hoffe hier auf ein bischen Unterstützung.

Zu meinem Problem:

Ich habe mehrere 100 txt-Dateien die ich in Excel importieren möchte. Ich habe mal ein Makro aufgezeichnet was schon fast meine Anforderungen erfüllt.
Die Datei wird importiert, anhand der Trennzeichen die Tabelle erstellt, die nicht benötigten Spalten werden herausgelöscht und die verbleibenden werden benannt. s.u.

Jetzt hätte ich gerne, dass ich ALLE Dateien welche sich in einem Verzeichnis befinden auswählen kann und diese automatisch nach u.a. Schema in eine Exceldatei importiert werden und für jede einzelne Datatei ein eigenes Arbeitsblatt angelegt wird, welches dann mit dem Original Dateinamen benannt wird.

Beim Import muss die *.txt durch Leerzeichen und Anführungszeichen getrennt werden (TextToColumns .Cells(1), Space:=True / TextToColumns .Cells(1), Other:=True, OtherChar:="""")

Wenn der Import durchgeführt ist müssen in jedem Sheet die Spalten (A:B:D:F:G:H:J:K:L:M:N:O:P) gelöscht werden, diese werden nicht benötigt.

Weitehin soll dann noch eine Überschriftenzeile für die 3 verbleibenen Spalten eingefügt werden: A1=Stueck, B1=Preis, C1=Art.Nr.

Anbei mal eine txt und eine xls als Veranschaulichung. Und das aufgezeichnete Makro...

https://www.herber.de/bbs/user/107523.txt

https://www.herber.de/bbs/user/107524.xls

Sub Makro1()
    '
    '
    '
        ChDir "D:\test"
        Workbooks.OpenText Filename:="D:\test\Test.txt", Origin:= _
            xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=True, Other:=True, OtherChar:="""", FieldInfo:= _
            Array(Array(1, 9), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 1), Array(6, 9),  _
Array(7 _
            , 9), Array(8, 9), Array(9, 1), Array(10, 9), Array(11, 9), Array(12, 9), Array(13,  _
9), Array _
            (14, 9), Array(15, 9), Array(16, 9)), TrailingMinusNumbers:=True
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Stueckzahl"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Preis"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Art.-Nr."
        Range("A1:C1").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Columns("B:B").Select
        ActiveCell.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Find(What:=",", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="(", Replacement:=" ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        With Selection
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End Sub

  

Betrifft: Ich bastel Dir was... von: Michael (migre)
Geschrieben am: 10.08.2016 11:26:32

Andie,

...bin nur grade noch im Stress - ich melde mich in einer Stunde ca.

LG
Michael


  

Betrifft: AW: Ich bastel Dir was... von: Andie
Geschrieben am: 10.08.2016 12:51:37

Hallo Michael,

vielen lieben Dank :-)


  

Betrifft: Teste mal dies... von: Michael (migre)
Geschrieben am: 10.08.2016 13:29:07

Andie,

...hab's gleich in eine Datei gepackt: https://www.herber.de/bbs/user/107530.xlsm
Schaltfläche im ersten Tabellenblatt startet die Routine - Du kannst das Verzeichnis der Textdateien in einem Dialog wählen, dann werden alle dort vorhandenen .txt-Dateien nacheinander in die Mappe eingefügt.

Test das mal, ob das Deinen Vorstellungen entspricht!

LG
Michael


  

Betrifft: AW: Teste mal dies... von: Andie
Geschrieben am: 10.08.2016 13:56:17

Hallo Michael,

du bist auf jeden Fall mein Held des Jahres, du glaust gar nicht wieviel Zeit mir
deine Hilfe spart. SUPER SUPER SUPER!!! :-D

Bekommst du es auch hin, dass alle Preise mit 2 Dezimalstellen und einem Punkt statt Komma zur Trennung
angezeigt werden?

VIELEN, VIELEN DANK!!!!


  

Betrifft: Ja klar, teste das nochmal... von: Michael (migre)
Geschrieben am: 10.08.2016 14:34:17

Andie,

...nochmals direkt in einer Datei: https://www.herber.de/bbs/user/107533.xlsm

Ich hab Dir eine Option in den Code reingenommen, dass Du der Punkt zum Dezimaltrenner wird - nachdem das aber eine globale Einstellung ist (in jeder Mappe) hab ich's mal auskommentiert drinnen gelassen, und nur die zwei Dezimalstellen reingenommen - die Stelle ist im Code kommentiert, kannst Du nach Wunsch übernehmen.

LG
Michael


  

Betrifft: AW: Ja klar, teste das nochmal... von: Andie
Geschrieben am: 10.08.2016 14:48:06

Hallo Michael,

super klasse!!! es ist genauso wie ich's mir vorgestellt hab.

Nochmals ganz lieben Dank für deinen Einsatz und das auch noch in so kurzer Zeit.

Ich werde deine Künste weiter empfehlen und das nächste Bierchen geht auf mich ;-)

Weiter so.....!


  

Betrifft: Aber gern! Danke für die nette Rückmeldung, owT von: Michael (migre)
Geschrieben am: 10.08.2016 15:12:53




  

Betrifft: AW: Aber gern! Danke für die nette Rückmeldung, owT von: Andie
Geschrieben am: 15.08.2016 08:57:59

Hallo Michael,

nachdem ich schon einige txt importiert habe, ist mir aufgefallen, dass
die erste Zeile der Tabelle(wenn die Überschriften eingefügt werden) überschrieben wird.

D.h. es wird keine Zeile für die Überschriften eingefügt, ließe sich dies vielleicht noch anpassen?

lg
Andie


  

Betrifft: AW: Aber gern! Danke für die nette Rückmeldung, owT von: Andie
Geschrieben am: 15.08.2016 09:45:37

Hallo Michael,

nachdem ich schon einige txt importiert habe, ist mir aufgefallen, dass
die erste Zeile der Tabelle(wenn die Überschriften eingefügt werden) überschrieben wird.

D.h. es wird keine Zeile für die Überschriften eingefügt, ließe sich dies vielleicht noch anpassen?

lg
Andie


  

Betrifft: Hallo Michael(migre) schaust du bitte nochmal rein von: Andie
Geschrieben am: 15.08.2016 16:54:35

Hallo Michael,

nachdem ich schon einige txt importiert habe, ist mir aufgefallen, dass
die erste Zeile der Tabelle(wenn die Überschriften eingefügt werden) überschrieben wird.

D.h. es wird keine Zeile für die Überschriften eingefügt, ließe sich dies vielleicht noch anpassen?

lg
Andie


  

Betrifft: Hallo Michael(migre) schaust du bitte nochmal rein von: Andie
Geschrieben am: 15.08.2016 16:55:04

Hallo Michael,

nachdem ich schon einige txt importiert habe, ist mir aufgefallen, dass
die erste Zeile der Tabelle(wenn die Überschriften eingefügt werden) überschrieben wird.

D.h. es wird keine Zeile für die Überschriften eingefügt, ließe sich dies vielleicht noch anpassen?

lg
Andie


  

Betrifft: Bin am WE nie (!) im Forum, ich schau morgen! owt von: Michael (migre)
Geschrieben am: 16.08.2016 00:03:27




  

Betrifft: Hier nochmal ergänzt - teste mal! von: Michael (migre)
Geschrieben am: 16.08.2016 10:39:30

Hallo Andie!

Hier nochmal ergänzt: https://www.herber.de/bbs/user/107644.xlsm
Bitte testen, ob ich Dich richtig verstanden habe!

LG
Michael


  

Betrifft: AW: Hier nochmal ergänzt - teste mal! von: Andie
Geschrieben am: 16.08.2016 12:01:50

Hallo Michael,

hast du :-) Alles Supi, Vielen lieben Dank für die Anpassung.

LG
Andie


  

Betrifft: Gerne, kein Problem! Lg und owt von: Michael (migre)
Geschrieben am: 16.08.2016 12:19:50




Beiträge aus den Excel-Beispielen zum Thema " txt-Dateien in Excel importieren per Makro"