Office: Probleme beim einlesen von .txt in Excel

mrflix · 24. August 2016

Hallo zusammen ich habe mehrere .txt Dateien mit Daten die aus CAD exportiert werden. Diese enthalten Gerätecodes, Raumnummern, Anzahl und den Zeichnungslayer. Pro Ebene habe ich immer eine txt. Datei. Ich habe mir für mein anliegen ein kleines Programm geschrieben das mir den großteil der Arbeit abnimmt. Das läuft auch ganz gut soweit. *Smilie

Das Problem ist das beim importieren der Daten die Raumnummern nicht richtig übernommen werden. Seltsamerweise jedoch nicht alle.*eek.gif*

Die Raumnummern sind so aufgebaut Bsp.: U1.001; 00.101; 01.101;....
Hierbei ist die vordere Nummer immer die Kennung der Ebene. Bei U1. und 00. funktioniert alles prächtig, aber ab Ebene 1 wir aus 01.001 nun 1001.

Den Fehler habe ich, glaube ich zumindest, gefunden weiß jedoch nicht wie ich ihn lösen soll.*frown.gif*

Hier mal der Code:

Code:

Dim wbTarget As Workbook, wbSource As Workbook
Dim ws As Worksheet, ts As Worksheet, wks As Worksheet
Set FSO = CreateObject("Scripting.Filesystemobject")
Set wbTarget = ActiveWorkbook
Application.DisplayAlerts = False

wbTarget.Worksheets(1).Name = "Zusammenfassung"
wbTarget.Worksheets(1).Range("A:ZZ").Clear

For Each f In FSO.GetFolder(Pfad).Files
If LCase(Right(f.Name, 3)) = "txt" Then
Workbooks.OpenText Filename:=f.Path
Set wbSource = ActiveWorkbook
On Error Resume Next
Set ws = wbTarget.Worksheets(f.Name)
If Err 0 Then
Set ws = wbTarget.Worksheets.Add
ws.Name = f.Name
ws.Range("A:ZZ").Clear
End If

wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Semicolon:=True, Other:=False, _
FieldInfo:=Array( _
Array(1, xlTextFormat), Array(2, xlTextFormat), _
Array(3, xlTextFormat), Array(4, xlTextFormat), _
Array(5, xlGeneralFormat), Array(6, xlTextFormat), _
Array(7, xlTextFormat)), _
TrailingMinusNumbers:=True
wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
wbSource.Close False
End If
Next
Set ts = wbTarget.Worksheets("Zusammenfassung")
ts.Move After:=Sheets(Sheets.Count)
Dim curCell As Range
Set curCell = ts.Range("A1")
For i = 1 To wbTarget.Worksheets.Count - 1
maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
Set curCell = curCell.End(xlDown).Offset(2, 0)
Next

For Each wks In Sheets
If wks.Name "Zusammenfassung" Then wks.Delete
Next

Application.DisplayAlerts = True
Set FSO = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Fehler tritt beim Übertragen der Quell- in die Zieltabelle in folgender Zeile auf:

wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")

Kann mir jemand sagen wie ich das Problem lösen kann und warum es bei 00. klappt und bei 01.,02. etc. nicht?

Danke im Vorraus

Gruß Mr. Flix

:)

Hajo_Zi · 26. August 2016

vielleicht solltest Du Value übertragen.
Du hast ja die TXT Datei.

RPP63 · 26. August 2016

Moin!
Formatiere die Raumnummernspalte vorher explizit als Text.

Gruß Ralf

mrflix · 26. August 2016

\@ Hajo

Vielen Dank für deine Antwort leider weiß ich nicht wirklich etwas damit anzufangen.

@RPP63neu
Tue ich das nicht schon beim Einlesen über die Array mit xlTextFormat?

Vielleicht noch zur Info, ich bin ein Laie was das angeht. Im normalfall schaue ich immer nach befehlen und in Foren und mische das dann zusammen oO

Ihr müsst mir mein Problem nicht lösen aber, und das jetzt bitte nicht Falsch verstehen, etwas mehr unterstüzung im Bezug auf Hinweise bräuchte ich schon als einzelne Schlagworte.

RPP63 · 26. August 2016

Moin!

Tue ich das nicht schon beim Einlesen über die Array mit xlTextFormat?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Theoretisch ja. ;-)
Es wäre sinnvoll, Du würdest mal so eine CAD.txt hochladen, dann kann man testen, ob die lästige "Bauernschläue" von Excel überlistet werden kann (dies hat Dir Hajo mit seiner Antwort verdeutlichen wollen).
(Eine zusätzliche Formatierung der einzelnen Spalten schadet jedenfalls nicht)

Gruß Ralf

mrflix · 26. August 2016

ah ok *upps

Ja klar hier die Datei und nochmals Vielen Dank

RPP63 · 26. August 2016

Soderle …
Ich bin jetzt mal nicht über Workbooks.OpenText gegangen, sondern habe die .txt importiert (.QueryTables.Add).
Der Import klappt bei mir problemlos.
Dabei habe ich mal den Rekorder laufen lassen:

Sub Makro2()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\RalfP\Desktop\Übung\Test.txt", Destination:=Range("$A$1"))
.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 = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bekommst Du dies in Deinen Code integriert?

Gruß Ralf

mrflix · 26. August 2016

mhm muss ich mal probieren, ich meld mich wieder. Vielen Dank erstmal*Smilie

xlph · 26. August 2016

Code:

Option Explicit

Public Sub xlph_Import_Txt()

Dim wksCollection As Worksheet

Dim strPath As String
Dim strFile As String

Dim lngRowsCount As Long

Set wksCollection = ThisWorkbook.Worksheets("Zusammenfassung")

wksCollection.UsedRange.Clear

strPath = "E:\Test\" ' anpassen *****

strFile = Dir(strPath & "*.txt")

Application.ScreenUpdating = False

Do Until strFile = ""
With Workbooks.Open(Filename:=strPath & strFile)
With .Worksheets(1).Range("A1").CurrentRegion
.Copy Destination:=wksCollection.Cells(1 + lngRowsCount, 1)
lngRowsCount = lngRowsCount + .Rows.Count
End With
.Close SaveChanges:=False
End With
strFile = Dir()
Loop

With wksCollection

.Columns(1).TextToColumns _
Destination:=.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, _
Other:=False, _
FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True

End With

Application.ScreenUpdating = True

Set wksCollection = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Probleme beim einlesen von .txt in Excel

Probleme beim einlesen von .txt in Excel

Probleme beim einlesen von .txt in Excel

Probleme beim einlesen von .txt in Excel

Probleme beim einlesen von .txt in Excel

Probleme beim einlesen von .txt in Excel - Similar Threads - Probleme einlesen Excel

Probleme mit dem automatisches Inhaltsverzeichnis

Probleme mit bedingter Formatierung

Probleme mit Formatierung in geschütztem Word-Dokument – Schriftstil nicht änderbar

VBA-Makro zur Zellenformatierung Syntax probleme

Probleme mit Makro das jede Zeile in der ein "Text" steht löscht?!

Probleme mit dem Kopieren aus Daten aus OneNote 2016

Probleme mit Summewenn bei neuer EXCEL Version