AW: Textdatei mit fester Spaltenbreite lesen
23.07.2020 08:59:30
volti
Hallo Jürgen,
hier noch mal ergänzend zu den anderen Lösungswegen eine reine VBA-Realisierung.
Probiere es mal aus, wenn Du Lust hast. Ist halt ein wenig aufwändiger.
[+][-]
Sub ImportFestBreite()
Dim sFilename As String, iFF As Integer, i As Integer, iPos As Integer
Dim iZeile As Long, WSh As Worksheet
Dim sArrZL() As String, sArrPos() As Integer, sArrSP() As String
Set WSh = ActiveSheet
sFilename = "C:\Users\voltm\Desktop\Testdaten.txt"
iFF = FreeFile
If Dir(sFilename) <> "" Then
Open sFilename For Input As iFF
sArrZL = Split(Input(LOF(iFF), iFF), vbCrLf)
Close iFF
'Spaltenpositionen ermitteln
For iPos = 1 To Len(sArrZL(1))
If Mid(sArrZL(1), iPos, 1) = " " And Mid(sArrZL(1), iPos + 1, 1) <> " " Then
ReDim Preserve sArrPos(i)
sArrPos(i) = iPos: i = i + 1
End If
Next iPos
WSh.Cells(iZeile + 1, "A").value = sArrZL(0)
For iZeile = 1 To UBound(sArrZL)
For i = 0 To UBound(sArrPos)
If sArrPos(i) < Len(sArrZL(iZeile)) Then
Mid(sArrZL(iZeile), sArrPos(i), 1) = vbTab
End If
Next i
For i = 1 To 16
sArrZL(iZeile) = Replace(sArrZL(iZeile), " " & vbTab, vbTab)
sArrZL(iZeile) = Replace(sArrZL(iZeile), " " & vbTab, vbTab)
Next i
sArrSP = Split(sArrZL(iZeile), vbTab)
WSh.Cells(iZeile + 1, "A").Resize(1, UBound(sArrSP) + 1).value = sArrSP
Next iZeile
End If
End Sub
Sub ExportFestBreite()
Dim sFilename As String, iFF As Integer, i As Integer, iPos As Integer
Dim iZeile As Long, iSpalte As Integer, WSh As Worksheet
Dim sArrZL() As String, sArrPos() As Integer, sArrSP() As String
Dim sZeile As String, iLang As Integer
Set WSh = ActiveSheet
sFilename = "C:\Users\voltm\Desktop\Testdaten.txt"
iFF = FreeFile
Open sFilename For Input As iFF
Line Input #iFF, sZeile: Line Input #iFF, sZeile
Close iFF
'Spaltenbreiten ermitteln
For iPos = 1 To Len(sZeile)
If Mid(sZeile, iPos, 1) = " " And Mid(sZeile, iPos + 1, 1) <> " " Then
i = i + 1
ReDim Preserve sArrPos(i)
sArrPos(i) = iPos - iLang
iLang = iLang + sArrPos(i)
End If
Next iPos
'Jetzt die Daten schreiben
Open sFilename For Output As iFF
Print #iFF, WSh.Cells(1, "A").value & vbCrLf
For iZeile = 2 To WSh.Cells(WSh.Rows.Count, 1).End(xlUp).Row - 1
sZeile = ""
For iSpalte = 1 To UBound(sArrPos)
sZeile = sZeile & Left(WSh.Cells(iZeile, iSpalte).value _
& Space(50), sArrPos(iSpalte))
Next iSpalte
Print #iFF, sZeile
Next iZeile
Print #iFF, WSh.Cells(iZeile, "A").value
Close iFF
End Sub
viele Grüße aus Freigericht
Karl-Heinz