Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1300to1304
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1300to1304
1300to1304
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

export in .txt

export in .txt
07.03.2013 21:00:44
joschy7
Hallo zusammen,
ich habe ein Problem: Meine Aufgabe lautet Daten aus verschiedenen Zellen in einen String mit 128 Zeichen zu exportieren. Die Felder haben unterschiedliche Feldlängen.
Problem dabei ist, das auch die Zeilen nicht alle gleich sind, ein Beispiel
Leerzeichen stehen immer für eine neue Spalte
A3
16631 00000000000000000
40 23603 735 8 7701376510 3564 Test 00020 00020050 0000 345006 000000000000 000000401000
40 23603 735 8 7701376510 3564 Test 00020 00020050 0000 345006 000000000000 000000401000
40 23603 735 8 7701376510 3565 Test 00020 00020050 0000 345006 000000000000 000000401000
3 5081935 2802130000007 575800000000000000000 000000000000000000 00000000757580000000143
Die Zeilen die Fett markiert (ab Zeile zwei) sind können mal nur eine Zeile oder aber auch mal 200 Zeilen sein. Beginnen aber immer mit 40. Die letzte Zeile beinhaltet in A immer die Zahl 3
Was ich schon gefunden habe :
Sub Export()
Dim strTmp As String, strText As String, strFile As String, strTmp1 As String
Dim intRow As Integer, intCol As Integer, intRow1 As Integer, intCol1 As Integer
Dim iRowL As Integer, iRow As Integer
strFile = InputBox("Dateiname:", , "c:\excel\test.txt")
If strFile = "" Then Exit Sub
Open strFile For Output As #1
For intRow1 = 3 To 3
For intCol1 = 1 To ActiveSheet.UsedRange.Columns.Count
strText = Cells(intRow1, intCol1).Text
strText = WorksheetFunction.Substitute(strText, "ö", "")
Select Case intCol1
Case 1: strTmp = strTmp & strText & String(5 - Len(strText), " ")
Case 2: strTmp = strTmp & strText & String(123 - Len(strText), " ")
End Select
Next intCol1
Print #1, strTmp1
strTmp1 = ""
Next intRow1
 'For intRow = 4 To 20
iRow = Cells(Rows.Count, 1).End(xlUp).Row
For intRow = 4 To iRow
ActiveSheet.UsedRange.Rows.Count
For intCol = 1 To ActiveSheet.UsedRange.Columns.Count
strText = Cells(intRow, intCol).Text
strText = WorksheetFunction.Substitute(strText, "ö", "")
Select Case intCol
Case 1: strTmp = strTmp & strText & String(2 - Len(strText), " ")
Case 2: strTmp = strTmp & strText & String(5 - Len(strText), " ")
Case 3: strTmp = strTmp & strText & String(3 - Len(strText), " ")
Case 4: strTmp = strTmp & strText & String(1 - Len(strText), " ")
Case 5: strTmp = strTmp & strText & String(10 - Len(strText), " ")
Case 6: strTmp = strTmp & strText & String(4 - Len(strText), " ")
Case 7: strTmp = strTmp & strText & String(17 - Len(strText), " ")
Case 8: strTmp = strTmp & strText & String(5 - Len(strText), " ")
Case 9: strTmp = strTmp & strText & String(8 - Len(strText), " ")
Case 10: strTmp = strTmp & strText & String(4 - Len(strText), " ")
Case 11: strTmp = strTmp & strText & String(6 - Len(strText), " ")
Case 12: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 13: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 14: strTmp = strTmp & strText & String(39 - Len(strText), " ")
End Select
Next intCol
Print #1, strTmp
strTmp = ""
Next intRow
Close
End Sub

Bei dem Fett markierten komme ich nicht weiter, ich schaffe es nicht variabel zwischen Spalte 2 und egal zu gestalten.
Vielen Dank, wenn ihr es mal anschaut!

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

Betreff
Datum
Anwender
Anzeige
AW: export in .txt
07.03.2013 23:35:40
Franc
Ich bin denk nicht der einzige der sich jetzt fragt ... WAS? ^^
Bei deinem Beispiel ist eine fett markierte Zeile 76 Zeichen lang.
Sollen ein Block mit 40 bis 3 zusammengefasst oder Zeile für Zeile betrachtet werden und die 40 zeigt nur den Beginn und die 3 das Ende von dem block?
Womit soll man das auf 128 Zeichen auffüllen?
Kommt das öfter vor das es Abschnitte mit 40 beginnend und 3 endend gibt?
Ich empfehle dir ganz klar eine Beispieltabelle zu erstellen und dann meinetwegen in Blatt 2 was am Ende dabei rauskommen soll. Je ausführlicher beschrieben desto besser.
Der oben gezeigte Code ist denk nicht ansatzweise auf dein Bedürfnis angepasst oder?
Das mit dem exportieren ist relativ einfach - schwer ist nur zu verstehen nach welchen Regeln die Daten aufbereitet werden sollen.

Anzeige
AW: export in .txt
08.03.2013 01:07:47
Erich
Hi Franc,
was meinst du dazu? 

Option Explicit
Sub Export()
Dim strTmp As String, strT As String, strFile As String
Dim iRow As Long, iCol As Long
strFile = InputBox("Dateiname:", , "c:\excel\test.txt")
If strFile = "" Then Exit Sub
Open strFile For Output As #1
iRow = 3
For iCol = 1 To 2
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
Select Case iCol
Case 1: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 2: strTmp = strTmp & strT & String(123 - Len(strT), "Q")
End Select
Next iCol
Print #1, strTmp
For iRow = 4 To Cells(Rows.Count, 1).End(xlUp).Row
strTmp = ""
If Cells(iRow, 1) = 40 Then      ' Satzart 40
For iCol = 1 To 14
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
Select Case iCol
Case 1: strTmp = strTmp & strT & String(2 - Len(strT), "#")
Case 2: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 3: strTmp = strTmp & strT & String(3 - Len(strT), "#")
Case 4: strTmp = strTmp & strT & String(1 - Len(strT), "#")
Case 5: strTmp = strTmp & strT & String(10 - Len(strT), "#")
Case 6: strTmp = strTmp & strT & String(4 - Len(strT), "#")
Case 7: strTmp = strTmp & strT & String(17 - Len(strT), "#")
Case 8: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 9: strTmp = strTmp & strT & String(8 - Len(strT), "#")
Case 10: strTmp = strTmp & strT & String(4 - Len(strT), "#")
Case 11: strTmp = strTmp & strT & String(6 - Len(strT), "#")
Case 12: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 13: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 14: strTmp = strTmp & strT & String(39 - Len(strT), "Q")
End Select
Next iCol
Print #1, strTmp
ElseIf Cells(iRow, 1) = 3 Then   ' Satzart 3
' was soll bei Satzart 3 (letzter Satz) ausgegeben werden?
End If
Next iRow
Close
End Sub
Daraus entsteht https://www.herber.de/bbs/user/84242.txt
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: export in .txt
08.03.2013 11:44:37
joschy7
Hallo zusammen,
leider klappt der Vorschlag von Erich noch nicht so recht, ich kriege es leider nicht zusammen.
Ich habe mal eine Muster Datei erstellt mit dem Code von Erich und meinem Ansatz für die letzte Zeile.
Die zweite Datei zeigt wie das Ergebnis aussehen müsste....
Vielen Dank für euere Unterstützung und sonnige Grüße aus der Eifel
https://www.herber.de/bbs/user/84247.xlsm
https://www.herber.de/bbs/user/84248.txt

Text-Export nach Satzaufbau
09.03.2013 10:01:27
Erich
Hi Joschy,
warum hast du die Anweisung
strTmp = ""
auskommentiert? Das verursacht Chaos.
Hier mal drei Varianten, wobei Export3() nur zusammen mit der Satzbeschreibung im Tabellenblatt "Aufbau"
verständlich ist: 

Option Explicit
Sub Export3()
Dim strFile As String, arSA, arAn, arrL, arrW, SArt As Long
Dim strAus As String, iRow As Long, iCol As Long, strT As String
strFile = InputBox("Dateiname:", , "c:\excel\test.txt")
If strFile = "" Then Exit Sub
'   strFile = "c:\excel\tttt3.txt"                       ' zum Testen
Open strFile For Output As #1
arAn = Application.Transpose(Range("FAnz"))  ' Anzahl Felder
arrL = Range("Felder")                       ' Feldlängen
With Sheets("Tabelle1")                      ' Daten einlesen in Array
arrW = .Cells(3, 1).Resize _
(.Cells(.Rows.Count, 1).End(xlUp).Row - 2, Application.Max(arAn))
End With
For iRow = 1 To UBound(arrW)
strAus = ""
Select Case arrW(iRow, 1)                 ' Satzart ermitteln
Case 40: SArt = 2
Case 3:  SArt = 3
Case Else:  SArt = 1
End Select
For iCol = 1 To arAn(SArt)                ' Spalten verarbeiten
strT = WorksheetFunction.Substitute(arrW(iRow, iCol), "ö", "")
strAus = strAus & strT & String(arrL(SArt, iCol) - Len(strT), "#")
Next iCol
Print #1, strAus
Next iRow
Close
End Sub
Sub Export2()
Dim strTmp As String, strT As String, strFile As String, SArt As Long
Dim iRow As Long, iCol As Long, arrL(1 To 3, 0 To 14), arr
strFile = InputBox("Dateiname:", , "c:\excel\test.txt")
If strFile = "" Then Exit Sub
'   strFile = "c:\excel\tttt2.txt"                       ' zum Testen
arr = Array(5, 123)
arrL(1, 0) = UBound(arr) + 1
For iCol = 1 To arrL(1, 0)
arrL(1, iCol) = arr(iCol - 1)         ' SArt 1 (1. Satz)
Next iCol
arr = Array(2, 5, 3, 1, 10, 4, 17, 5, 8, 4, 6, 12, 12, 39)
arrL(2, 0) = UBound(arr) + 1
For iCol = 1 To arrL(2, 0)
arrL(2, iCol) = arr(iCol - 1)         ' SArt 2 (40)
Next iCol
arr = Array(1, 8, 6, 12, 36, 12, 12, 12, 29)
arrL(3, 0) = UBound(arr) + 1
For iCol = 1 To arrL(3, 0)
arrL(3, iCol) = arr(iCol - 1)         ' SArt 3 (3)
Next iCol
Open strFile For Output As #1
For iRow = 3 To Cells(Rows.Count, 1).End(xlUp).Row
strTmp = ""
Select Case Cells(iRow, 1)
Case 40: SArt = 2
Case 3:  SArt = 3
Case Else:  SArt = 1
End Select
For iCol = 1 To arrL(SArt, 0)
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
strTmp = strTmp & strT & String(arrL(SArt, iCol) - Len(strT), "#")
Next iCol
Print #1, strTmp
Next iRow
Close
End Sub
Sub Export()
Dim strTmp As String, strT As String, strFile As String
Dim iRow As Long, iCol As Long
strFile = InputBox("Dateiname:", , "c:\excel\test.txt")
If strFile = "" Then Exit Sub
'   strFile = "c:\excel\tttt1.txt"                       ' zum Testen
Open strFile For Output As #1
iRow = 3
For iCol = 1 To 2
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
Select Case iCol
Case 1: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 2: strTmp = strTmp & strT & String(123 - Len(strT), "Q")
End Select
Next iCol
Print #1, strTmp
For iRow = 4 To Cells(Rows.Count, 1).End(xlUp).Row
strTmp = ""                                           ' Warum auskommentiert?
If Cells(iRow, 1) = 40 Then      ' Satzart 40
For iCol = 1 To 14
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
Select Case iCol
Case 1: strTmp = strTmp & strT & String(2 - Len(strT), "#")
Case 2: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 3: strTmp = strTmp & strT & String(3 - Len(strT), "#")
Case 4: strTmp = strTmp & strT & String(1 - Len(strT), "#")
Case 5: strTmp = strTmp & strT & String(10 - Len(strT), "#")
Case 6: strTmp = strTmp & strT & String(4 - Len(strT), "#")
Case 7: strTmp = strTmp & strT & String(17 - Len(strT), "#")
Case 8: strTmp = strTmp & strT & String(5 - Len(strT), "#")
Case 9: strTmp = strTmp & strT & String(8 - Len(strT), "#")
Case 10: strTmp = strTmp & strT & String(4 - Len(strT), "#")
Case 11: strTmp = strTmp & strT & String(6 - Len(strT), "#")
Case 12: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 13: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 14: strTmp = strTmp & strT & String(39 - Len(strT), "Q")
End Select
Next iCol
Print #1, strTmp
ElseIf Cells(iRow, 1) = 3 Then   ' Satzart 3
For iCol = 1 To 9
strT = WorksheetFunction.Substitute(Cells(iRow, iCol).Text, "ö", "")
Select Case iCol
Case 1: strTmp = strTmp & strT & String(1 - Len(strT), "#")
Case 2: strTmp = strTmp & strT & String(8 - Len(strT), "#")
Case 3: strTmp = strTmp & strT & String(6 - Len(strT), "#")
Case 4: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 5: strTmp = strTmp & strT & String(36 - Len(strT), "#")
Case 6: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 7: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 8: strTmp = strTmp & strT & String(12 - Len(strT), "#")
Case 9: strTmp = strTmp & strT & String(29 - Len(strT), "Q")
End Select
Next iCol
Print #1, strTmp
End If
Next iRow
Close
End Sub
Und hier die Mappe: https://www.herber.de/bbs/user/84260.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
sorry
08.03.2013 01:14:44
Erich
Hi Joschy und Franc,
meinen letzten Beitrag habe ich ja wohl falsch aufgehängt und adressiert. Joschy ist der Fragesteller...
Hier noch eine Erklärung zum Code: Beim Auffüllen habe ich die Leerzeichen durch # bzw Q ersetzt.
Das ist nur zum Testen gedacht - man sieht einfach mehr.
Unklar ist, wie beim letzten Satz ("Satzart 3") verfahren werden soll.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: sorry
08.03.2013 09:13:51
joschy7
Hallo zusammen, erstmal Danke fürs reinschauen.
Hallo Erich, das ist genau die Umsetzung die ich brauche.
Bei Satzart 3 sollte wie folgt zusammengefügt werden:
Satzart 3 ist immer der Abschluss(die letzte Zeile in meiner Tabelle) und in SpalteA steht immer eine "3"
Case 1: strTmp = strTmp & strText & String(1 - Len(strText), " ")
Case 2: strTmp = strTmp & strText & String(8 - Len(strText), " ")
Case 3: strTmp = strTmp & strText & String(6 - Len(strText), " ")
Case 4: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 5: strTmp = strTmp & strText & String(36 - Len(strText), " ")
Case 6: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 7: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 8: strTmp = strTmp & strText & String(12 - Len(strText), " ")
Case 9: strTmp = strTmp & strText & String(29 - Len(strText), " ")
Ich hoffe man kann mich verstehen ?!?! Sonst erstelle ich wirklich eine Tabelle wie Franc geschrieben hat. Danke Euch !!!
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige