Txt. Dateien in Excel korrekt einlesen

Hallo zusammen,
ich habe folgendes Problem:
Ich muss per VBA Makro mehrere Textdateien in Excel einlesen und habe dafür folgendes Programm geschrieben:
A = 1
d = Dir("C:\Dateipfad\")
Do While d ""
x = Sheets(A).UsedRange.Rows.Count
Open "C:\Dateipfad\" & d For Input As #1
Do While Not EOF(1)
Line Input #1, temp
Cells(x, 1) = Replace(temp, vbTab, " ")
x = x + 1
Loop
Close #1
For j = 1 To x
Text = Split(Cells(j, 1), " ")
For i = 0 To UBound(Text)
Cells(j, i + 1) = Text(i)
Next
Next
d = Dir
Loop
Und hier ist ein Ausschnitt aus den einzufügenden Textdateien:
10838201112021150 86 73 24 30 48 47 51 68 81 9470 0
10838201112021200 86 74 22 26 49 47 51 68 81 9470 0
10838201112021210 86 76 22 24 50 48 51 68 81 9469 0
10838201112021220 88 75 23 21 51 48 51 68 81 9468 0
10838201112021230 94 73 24 23 51 49 51 68 81 9469 0
10838201112021240 102 67 24 34 52 49 51 68 81 9468 0
10838201112021250 109 64 25 37 53 49 51 67 81 9467 0
10838201112021300 107 62 25 44 54 50 51 67 81 9468 0
So jetzt ist mein Problem das beim Einfügen der Daten die Spalten verrutschen.
Mir ist bewusst, dass dies an den verschiedenen Anzahlen an Leerzeichen zwischen den Zahlen liegt.
Gibt es dafür eine bessere Lösung? ( evtl mit einer Array Funktion)
Viele Grüße
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton1_Click() ActiveSheet.Range("A1:L10").ClearContents With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Documents and Settings\User\Desktop\test.txt", Destination:= _ Range("A1")) .Name = "test" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub

Sub Test_Text2Column() Dim a As Long Dim d, xlfile As String a = 1 d = Dir("C:\Dateipfad\") Do While d "" If UCase(Mid(d, Len(d) - 3, 4)) = UCase(".TXT") Then 'nur TXT-files nehmen xlfile = Mid(d, 1, Len(d) - 4) & ".xlsx" Workbooks.OpenText Filename:=d, _ Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 2), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array( _ 8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select MsgBox "Datei: " & d & " wurde umgesetzt und wird jetzt als " & xlfile & " gespeichert." _ ActiveWorkbook.SaveAs Filename:=xlfile, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' ActiveWindow.Close ActiveWorkbook.Close End If d = Dir Loop d = d 'debug-stop only End Sub

Hallo nochmal zusammen,
Ich habe gerade gemerkt das ich beim Einlesen der Daten auf ein neues Problem gestoßen bin.
Der Code funktioniert prima soweit- Hier mal die Excel-Mappe mit dem Code:
https://www.herber.de/bbs/user/85272.xlsm
Er entspricht im wesentlichen dem "alten Code" mit dem Zusatz das ich per "Makro aufzeichnen" die Funktion 'text in Spalte' noch am Ende mit eingefügt habe. Doch genau hier liegt das neue Problem.
Beim Spalten in die entsprechenden Zeilen wird der Wert der am Ende in der Spalte A1 steht verändert. Das drückt sich so aus das anstelle von der Zahl 10838201111220010 die Zahl 10838201111220000 dort steht. Beim splitten wird immer die vorletzte Ziffer dieses Wertes auf 0 gesetzt, anstatt das diese sich Zeile für Zeile um 1 erhöht.
Vor dem Splitten sieht es noch so aus:
10838201111220000 12 98 33 22 26 36 48 72 91 9510 0
10838201111220010 13 98 31 14 26 35 48 72 91 9511 0
10838201111220020 15 99 32 17 25 35 48 72 91 9510 0
10838201111220030 13 99 32 15 25 35 48 72 91 9510 0
10838201111220040 10 99 33 17 25 35 48 72 91 9509 0
10838201111220050 9 99 33 18 25 35 48 72 91 9509 0
10838201111220100 10 99 33 18 25 35 48 72 91 9509 0
10838201111220110 11 99 33 18 25 35 48 72 91 9509 0
10838201111220120 7 99 34 18 24 34 48 72 91 9508 0
Danach:
10838201111220000 12 98 33 22 26 36 48 72 91 9510 0
10838201111220000 13 98 31 14 26 35 48 72 91 9511 0
10838201111220000 15 99 32 17 25 35 48 72 91 9510 0
10838201111220000 13 99 32 15 25 35 48 72 91 9510 0
10838201111220000 10 99 33 17 25 35 48 72 91 9509 0
10838201111220000 9 99 33 18 25 35 48 72 91 9509 0
10838201111220100 10 99 33 18 25 35 48 72 91 9509 0
10838201111220100 11 99 33 18 25 35 48 72 91 9509 0
Ich hoffe einer weis wie man dies lösen kann :)
Viele Grüße
Michael

Beliebteste Forumthreads (12 Monate)

Txt. Dateien in Excel korrekt einlesen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Txt. Dateien in Excel korrekt einlesen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread