.txt-Datei für Excel sauber strukturieren

[Elex]

Hi

fehlt doch nicht so viel.

Code:

Sub Liste()
Dim i As Long, Z, Pfad As String
On Error Resume Next
Application.ScreenUpdating = False
Pfad = Range("B2").Value

    Workbooks.OpenText Filename:=Pfad, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
       
i = Cells(Rows.Count, 1).End(xlUp).Row
Columns(1).Replace "  ", "#"
Range("A2:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("B2:B" & i).FormulaR1C1 = "=IF(LEFT(RC[-1],1)=""#"",""# ""&RC[-1],RC[-1])"
Range("B2:B" & i).Copy
Range("A2:A" & i).PasteSpecial (xlPasteValues)
Columns(2).Delete

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

Range("C2:F" & i).Value = Range("C3:F" & i + 1).Value
Range("F2:F" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For Each Z In Cells(1).CurrentRegion
  Z.Value = Trim(Z.Value)
  If Z.Column < 3 And Z.Row > 1 And Z.Value = "" Then Z.Value = Z.Offset(-1).Value
Next Z
Cells(1).CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Gruß Elex

[Rolf321]

Vielen Dank für die schnelle Antwort.

Hast du die .txt-Datei vorher einfach in Excel geöffnet?
Wenn ja, bei mir kommt da direkt der Textkonvertierungs-Assistent. Hast du den in irgendeiner Form benutzt? Wenn ja, was hast du da gemacht?


Wenn ich den Code anwende sieht das so aus.

   

Viele Grüße


Elex
Hi

fehlt doch nicht so viel.

Code:

Sub Liste()
Dim i As Long, Z, Pfad As String
On Error Resume Next
Application.ScreenUpdating = False
Pfad = Range("B2").Value

    Workbooks.OpenText Filename:=Pfad, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
       
i = Cells(Rows.Count, 1).End(xlUp).Row
Columns(1).Replace "  ", "#"
Range("A2:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("B2:B" & i).FormulaR1C1 = "=IF(LEFT(RC[-1],1)=""#"",""# ""&RC[-1],RC[-1])"
Range("B2:B" & i).Copy
Range("A2:A" & i).PasteSpecial (xlPasteValues)
Columns(2).Delete

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

Range("C2:F" & i).Value = Range("C3:F" & i + 1).Value
Range("F2:F" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

For Each Z In Cells(1).CurrentRegion
  Z.Value = Trim(Z.Value)
  If Z.Column < 3 And Z.Row > 1 And Z.Value = "" Then Z.Value = Z.Offset(-1).Value
Next Z
Cells(1).CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Gruß Elex

[Elex]

Hi

In #8 ist eine Datei.
In der Datei in Zelle B2 gibst du den Pfad und Namen der Textdatei an und klickst dann auf Start.

Ersetze dem Code in der Datei durch den aus #11.
Bei mir ist das Ergebnis so wie in deinem Beispiel aus #10.

Gruß Elex