ASCII-Datei splitten

Hallo :-),
ich bräuchte erneut Eure Hilfe. Ich habe min. 300 Datein (*.fel) die vom Aufbau immer gleich sind und per Makro in einzelne Datein gesplittet werden müssten. Geht sowas überhaupt? Wenn nein, dann nicht weiterlesen, hehe :-))
Anbei eine Beispieldatei um den Aufbau zu zeigen:


1         2         3         4         5         6         7
1234567891123456789212345678931234567894123456789512345678961234567897123
10001 50       0           121002        .0000     .0000   16.0223
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000
10005 50       0           121002        .0000     .0000  125.0874
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000
10006 50       0           121002        .0000     .0000    9.0123
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000
10007 50       0           121002        .0000     .0000    5.0254
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000

Ich möchte jetzt, dass diese Datei gesplittet wird nach folgenden Kriterien:
Wenn an der 10.-11. Stelle eine 50 steht, dann kopiere den bereich von der 50 bis zu der Zeile mit 54 und speichere es als Datei ab. Der neue Dateiname steht immer in der Schlüsselzeile 50 an 62.-69. Stelle. Wenn ein Dateiname schon vorhanden ist, dann um ein _A, _B,_C, ... ergänzen
Das Ergebnis wäre dann dieses:
Dateiname: VR_16_-_0223.fel

   10001 50       0           121002        .0000     .0000   16.0223
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000

Dateiname: VR_125_-_0874.fel

   10005 50       0           121002        .0000     .0000  125.0874
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000

Dateiname: VR_9_-_0123.fel

   10006 50       0           121002        .0000     .0000    9.0123
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000

Dateiname: VR_5_-_0254.fel

   10007 50       0           121002        .0000     .0000    5.0254
11000 98       0         00000000        .0000     .0000     .0000 047
12000 94     254         00000000      00.0000     .0000  100.0000 097
13000 48     547         00000000      00.0000     .0000  100.0000 077
30000 99       0         00000000      00.0000     .0000  100.0000 087
31000 54    1600              999        .0000     .0000     .0000

Hätte jemand ne Idee wie man sowas - ohne zu großen Aufwand - umsetzen könnte? Ich wäre für jede Hilfe unendlich dankbar, weil mir dadurch mehrere Wochen Copy&Paste-Arbeit erspart bleiben würden..
Hab' meine Testdatei (auf .txt geändert wegen dem Upload) hochgeladen:
https://www.herber.de/bbs/user/81616.txt
Vielen Dank!
LG,
Manu

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub fel_splitten() Dim i As Integer 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" 'Dialogfenster Öffnen iFile = Application.GetOpenFilename("alle Dateien (*.fel), *.fel") If iFile False Then Close Open iFile For Input As #1 i = 1 Do While Not EOF(1) Line Input #1, strTxt 'Cells(i, 1).Value = strTxt If Mid(strTxt, 10, 2) = "50" Then ' hier neue Ausgabedatei ausgabe = True aFile = "VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) & ".fel" Open aFile For Output As #2 End If If ausgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" Then ' Ausgabedatei schliesen ausgabe = False Close #2 End If i = i + 1 Loop Close End If End Sub

Sub fel_splitten() Dim i, nz As Integer 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" '+++ Dialogfenster Öffnen iFile = Application.GetOpenFilename("alle Dateien (*.fel), *.fel") If iFile False Then Close Open iFile For Input As #1 i = 1 anz = 0 Do While Not EOF(1) Line Input #1, strTxt 'Cells(i, 1).Value = strTxt If Mid(strTxt, 10, 2) = "50" Then ' hier neue Ausgabedatei ausgabe = True anz = anz + 1 aFile = "VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) & "_" & anz & ".fel" 'Leerzeichen im Dateinamen noch ersetzen aFile = Replace(aFile, " ", "", 1) Open aFile For Output As #2 'kopfzeile Schreiben Print #2, "Kopfzeile 1......." Print #2, "Kopfzeile 2......." End If If ausgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" Then ' Ausgabedatei schliesen ausgabe = False Close #2 End If i = i + 1 Loop Close End If End Sub

Hallo ede,
mein Gott bist du schnell. Ich möchte das auch können... :-)
Die Idee mit der Durchnummerrierung ist super, Danke!
Das mit den Kopfzeilen ist für meine Vorhaben leider unglücklich, weil ich bei jeder Datei einen anderen Kopf brauche mit variabler Anzahl an Zeilen und Inhalt. Im VBA-Code die Änderungen vorzunehmen wäre zwar möglich, aber leider sehr unpraktisch. Wäre es möglich wenn du dir meine Idee mit der Kopf.fel/.txt nochmal überdenkst? Würde mich sehr freuen! :-)
Eigentlich ist mein Kopf in jeder der eingelesenen Datein und müsste nur zusammenkopiert werden. Ich denke aber das ist zu kompliziert in der Umsetzung, daher würde mir die Kopf-Datei für manuelles anpassen reichen. Oder soll ich dir mal ein Beispiel geben damit du den Aufwand abschätzen kannst?
LG und DANKE,
Manu
P.S.: Du bist mein Held. Mir wird dadurch echt viel Arbeit erspart :-)))

Sub fel_splitten() Dim strHeader As String, aFile As String, iFile As String, strTxt As String Dim Ausgabe As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" strHeader = GetHeader() '+++ Dialogfenster Öffnen iFile = Application.GetOpenFilename("alle Dateien (*.fel), *.fel") If iFile False Then Reset Open iFile For Input As #1 Do While Not EOF(1) Line Input #1, strTxt If Mid(strTxt, 10, 2) = "50" Then ' hier neue Ausgabedatei Ausgabe = True aFile = "VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) _ & "_" & Format(Now, "YYMMDDhhmmss") & ".fel" 'Leerzeichen im Dateinamen noch ersetzen aFile = Replace(aFile, " ", "", 1) Open aFile For Output As #2 'kopfzeile Schreiben Print #2, strHeader End If If Ausgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" Then ' Ausgabedatei schliesen Ausgabe = False Close #2 End If Loop Close #1 End If End Sub Function GetHeader() Open "c:\temp\kopf.fel" For Input As #1 'anpassen GetHeader = Input(LOF(1), 1) Close #1 End Function

Option Explicit Sub fel_splitten() Dim i, nz, Ch, Da As Integer Dim Ver, iFile, aFile, strTxt As String Dim ausgabe 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" '+++ Dialogfenster Öffnen iFile = Application.GetOpenFilename("alle Dateien (*.fel), *.fel") If iFile False Then Close Open iFile For Input As #1 i = 1 Do While Not EOF(1) Line Input #1, strTxt If Mid(strTxt, 10, 2) = "50" Then ' hier neue Ausgabedatei ausgabe = True Ver = "A": Ch = 65 'code("A") Version aFile = Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) & "_" & Ver & ". _ fel", " ", "", 1) Do 'Prüfung ob aFile vorhanden ist Da = IIf(Len(Dir(aFile)) > 1, 1, 0) If Da = 1 Then 'bereits da Ch = Ch + 1 If Ch > 90 Then MsgBox "Dateiversion 'Z' erreicht" & Chr(13) _ & "unvollständige Ausgabe" Exit Sub End If Ver = Chr(Ch) aFile = Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) & "_" & _ Ver & ".fel", " ", "", 1) End If Loop Until Da = 0 'kopfzeile Schreiben FileCopy "Kopf.fel", aFile Open aFile For Append As #2 End If If ausgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" Then ' Ausgabedatei schliesen ausgabe = False Close #2 End If i = i + 1 Loop Close End If End Sub

204000 50 0 90966 .0000 .0000 18.0033 205000 54 1600 999 .0000 .0000 .0000 206000 50 0 90966 .0000 .0000 18.0032 207000 54 1600 999 .0000 .0000 .0000 208000 50 0 90966 .0000 .0000 18.0041 209000 10 0 29881104 .0000 .0000 .0000 007 210000 20 0 39880140 267.1000 .0000 100.0000 003 211000 20 0 39881225 88.3500 .0000 100.0000 099 212000 20 0 39880547 90.2400 .0000 100.0000 007 213000 24 1001 39200254 94.8300 .0000 100.0000 002 214000 22 183 39200224 166.4500 .0000 100.0000 002 215000 20 0 39890058 166.5300 .0000 100.0000 099 216000 20 0 39880548 170.7400 .0000 100.0000 007 217000 54 1600 999 .0000 .0000 .0000

Sub fel_splitten() Dim nz, Ch As Integer, Da As Integer Dim Ver, iFile, aFile, strTxt As String Dim blnAusgabe As Boolean, bln50 As Boolean Dim strExportPath As String Dim strImportPath As String 'StartVerzeichnis - bitte anpassen Const strDefaultPath As String = "c:\temp\" '+++ Importdatei wählen With Application.FileDialog(msoFileDialogFilePicker) .Title = "Importdatei wählen" .AllowMultiSelect = False .InitialFileName = strDefaultPath & "*.txt" If .Show = -1 Then iFile = .SelectedItems(1) End If End With If iFile "" Then strImportPath = CurDir & "\" 'Exportpfad wählen With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Bitte den Pfad wählen" .AllowMultiSelect = False .InitialFileName = strDefaultPath If .Show = -1 Then strExportPath = .SelectedItems(1) Else strExportPath = strDefaultPath End If End With If Right(strExportPath, 1) "\" Then strExportPath = strExportPath & "\" Reset Open iFile For Input As #1 Do While Not EOF(1) Line Input #1, strTxt If Mid(strTxt, 10, 2) = "50" Then ' hier neue Ausgabedatei blnAusgabe = True bln50 = True Ver = "A": Ch = 65 'code("A") Version aFile = strExportPath _ & Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) _ & "_" & Ver & ".fel", " ", "", 1) Do 'Prüfung ob aFile vorhanden ist Da = IIf(Len(Dir(aFile)) > 1, 1, 0) If Da = 1 Then 'bereits da Ch = Ch + 1 If Ch > 90 Then MsgBox "Dateiversion 'Z' erreicht" & Chr(13) _ & "unvollständige Ausgabe'", vbCritical, "Gebe bekannt..." Exit Sub End If Ver = Chr(Ch) aFile = strExportPath _ & Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) _ & "_" & Ver & ".fel", " ", "", 1) End If Loop Until Da = 0 'Kopfzeile Schreiben FileCopy strImportPath & "Kopf.fel", aFile Open aFile For Append As #2 Else bln50 = bln50 And Mid(strTxt, 10, 2) "54" End If If blnAusgabe Then Print #2, strTxt End If If Not bln50 Then 'Ausgabedatei schliesen blnAusgabe = False Close #2 End If Loop Close #1 End If End Sub

Sub fel_splitten() Dim nz, Ch As Integer, Da As Integer Dim Ver, iFile, aFile, strTxt As String Dim blnAusgabe As Boolean Dim strExportPath As String Dim strImportPath As String Dim strTest 'StartVerzeichnis - bitte anpassen Const strDefaultPath As String = "c:\temp\" '+++ Importdatei wählen With Application.FileDialog(msoFileDialogFilePicker) .Title = "Importdatei wählen" .AllowMultiSelect = False .InitialFileName = strDefaultPath & "*.fel" If .Show = -1 Then iFile = .SelectedItems(1) End If End With If iFile "" Then strImportPath = CurDir & "\" 'Exportpfad wählen With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Bitte den Pfad wählen" .AllowMultiSelect = False .InitialFileName = strDefaultPath If .Show = -1 Then strExportPath = .SelectedItems(1) Else strExportPath = strDefaultPath End If End With If Right(strExportPath, 1) "\" Then strExportPath = strExportPath & "\" Reset Open iFile For Input As #1 Do While Not EOF(1) 'vorhergehende Zeile If strTxt "" Then strTest = strTxt Else strTest = Space(15) End If Line Input #1, strTxt If Mid(strTxt, 10, 2) = "50" And Not blnAusgabe Then ' hier neue Ausgabedatei blnAusgabe = True Ver = "A": Ch = 65 'code("A") Version aFile = strExportPath _ & Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) _ & "_" & Ver & ".fel", " ", "", 1) Do 'Prüfung ob aFile vorhanden ist Da = IIf(Len(Dir(aFile)) > 1, 1, 0) If Da = 1 Then 'bereits da Ch = Ch + 1 If Ch > 90 Then MsgBox "Dateiversion 'Z' erreicht" & Chr(13) _ & "unvollständige Ausgabe'", vbCritical, "Gebe bekannt..." Exit Sub End If Ver = Chr(Ch) aFile = strExportPath _ & Replace("VR_" & Replace(Mid(strTxt, 62, 8), ".", "_-_", 1) _ & "_" & Ver & ".fel", " ", "", 1) End If Loop Until Da = 0 'Kopfzeile Schreiben FileCopy strImportPath & "Kopf.fel", aFile Open aFile For Append As #2 End If If blnAusgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" And Mid(strTest, 10, 2) "50" Then 'Ausgabedatei schliesen blnAusgabe = False Close #2 End If Loop Close #1 End If End Sub

...... If blnAusgabe Then Print #2, strTxt End If If Mid(strTxt, 10, 2) = "54" Then Select Case (Mid(strTest, 10, 2)) Case "50", "54" Case Else 'Ausgabedatei schliesen blnAusgabe = False Close #2 End Select End If Loop Close #1 End If End Sub

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread