ASCII-Datei mit festen Feldlängen aus Excel

Piece Länge Inhalt 1 5 interner Satzzähler 2 1 Satzart: 4 3 3 (leer) 4 8 (leer) 5 13 Barcode-Nr 6 8 Menge 7 8 (leer) 8 8 (leer)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub CreateASCII() Dim A As String, B As String, C As String, D As String, _ E As String, F As String, G As String, H As String Dim lRow As Long C = String(3, " ") D = String(8, " ") G = String(8, " ") H = String(8, " ") Open "c:\temp\test.txt" For Output As #1 For lRow = 1 To Cells(Rows.Count, 1).End(xlUp) A = Left(Cells(lRow, 1) & String(5, " "), 5) B = Cells(lRow, 2) E = Left(Cells(lRow, 3) & String(13, " "), 13) F = Left(Cells(lRow, 4) & String(8, " "), 8) Print #1, Join(Array(A, B, C, D, E, F, G, H), "/") Next Close #1 End Sub

Sub ASCII_Datei() On Error GoTo Fehler Dim TB, SP%, ZE%, LR&, i%, L% Dim TMP$, Pfad$, Datei$, Spaces$ Pfad = "C:\Temp\" Datei = "Test.txt" Set TB = ActiveSheet SP = 1 'Spalte A ZE = 2 'ab Zeile 2 LR = TB.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte Application.ScreenUpdating = False Close #1 Open Pfad & Datei For Output As 1 For i = ZE To LR TMP = Format(Cells(i, 1), "00000") & "/" '5stellig TMP = TMP & Cells(i, 2) & "/" '1stellig TMP = TMP & " /" '3stellig TMP = TMP & " /" '8stellig L = Len(Cells(i, 3)): Spaces = WorksheetFunction.Rept(" ", 13 - L) TMP = TMP & Cells(i, 3) & Spaces & "/" '13stellig L = Len(Cells(i, 4)): Spaces = WorksheetFunction.Rept(" ", 8 - L) TMP = TMP & Cells(i, 4) & Spaces & "/" '8stellig TMP = TMP & " /" '8stellig TMP = TMP & " /" '8stellig Print #1, TMP Next i Close #1 Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Sub ASCII_Dateianlegen() Dim strFile, Zeile As Long, Spalte As Long Dim strText As String, strTeil As String Dim FF As Integer Dim wks As Worksheet Const strSep As String = "/" 'Trennzeichen zwischen Feldern Set wks = ActiveSheet strFile = Application.GetSaveAsFilename(InitialFileName:="ASCII.txt", _ Filefilter:="Text(*.txt),*.txt", _ Title:="Dateiname für ASCII-File auswählen/eingeben") If strFile False Then FF = FreeFile() Open strFile For Output As #FF With wks For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row 'Startzeile ggf. anpassen strText = Format(.Cells(Zeile, 1), "00000") 'Satzzähler For Spalte = 2 To 8 Select Case Spalte Case 2 'Satzart With .Cells(Zeile, 2) If .Value = "" Then strTeil = " " Else strTeil = Left(.Text, 1) End If End With Case 3 '(3 Leerzeichen) strTeil = VBA.Space(3) Case 4, 7, 8 '(8 Leerzeichen) strTeil = VBA.Space(8) Case 5 'Barcode-Nr. With .Cells(Zeile, 3) If Len(.Text)

Piece Länge Inhalt 1 5 interner Satzzähler 2 1 Satzart: 7 3 3 Haus-ID 4 8 Kostenstellen-ID 5 13 Artikelnummer 6 8 Menge

Sub CreateASCII() Dim lRow As Long, lCol As Long Dim arrLen, arrOut(6) arrLen = Array(5, 1, 3, 8, 13, 8) Open "c:\temp\test.txt" For Output As #1 For lRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row For lCol = 0 To 5 arrOut(lCol) = Left(Cells(lRow, lCol + 1).Text & Space(arrLen(lCol)), arrLen(lCol)) Next Print #1, Join(arrOut, "/") Next Close #1 End Sub

Hallo
ich hatte aus den 3 ursprünglichen Lösungen mal eine zusammengebaut.
Diese habe ich abgeändert


Sub ASCII_Datei_2()
On Error GoTo Fehler
Dim ZE%, i%
Dim Datei
Dim A$, B$, C$, D$, E$, F$, G$, H$
Datei = Application.GetSaveAsFilename(InitialFileName:="ASCII.txt", _
Filefilter:="Text(*.txt),*.txt", _
Title:="Dateiname für ASCII-File auswählen/eingeben")
If Datei = False Then
MsgBox "Keine Daten erzeugt"
End
End If
ZE = InputBox("Daten ab Zeile", "Kopfzeile vorhanden", 2)
Close #1
Open Datei For Output As 1
For i = ZE To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
A = Format(Cells(i, 1), String(5, "0"))
B = Left(Cells(i, 2) & Space(1), 1)
C = Space(3)
D = Space(8)
E = Left(Cells(i, 3) & Space(13), 13)
F = Left(Cells(i, 4) & Space(8), 8)
'G = Space(8) '* geändert
'H = Space(8) '* geändert
'Print #1, Join(Array(A, B, C, D, E, F, G, H), "/")
Print #1, Join(Array(A, B, C, D, E, F), "/")'* geändert
Next i
Close #1
MsgBox "Daten erzeugt"
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Sub ASCII_Datei_2() On Error GoTo Fehler Dim ZE%, i% Dim Datei Dim A$, B$, C$, D$, E$, F$, G$, H$ Datei = Application.GetSaveAsFilename(InitialFileName:="ASCII.txt", _ Filefilter:="Text(*.txt),*.txt", _ Title:="Dateiname für ASCII-File auswählen/eingeben") If Datei = False Then MsgBox "Keine Daten erzeugt" End End If ZE = InputBox("Daten ab Zeile", "Kopfzeile vorhanden", 2) Close #1 Open Datei For Output As 1 For i = ZE To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row A = Format(Cells(i, 1), String(5, "0")) B = Left(Cells(i, 2) & Space(1), 1) C = Left(Cells(i, 3) & Space(3), 3) D = Left(Cells(i, 4) & Space(8), 8) E = Left(Cells(i, 5) & Space(13), 13) F = Left(Cells(i, 6) & Space(8), 8) Print #1, Join(Array(A, B, C, D, E, F), "/") Next i Close #1 MsgBox "Daten erzeugt" Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

ASCII-Datei mit festen Feldlängen aus Excel

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

ASCII-Datei mit festen Feldlängen aus Excel

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread