6
txt-Datei in Excel öffnen und dabei umformatieren mit einem Makro
Es geht um eine Kundenliste, die automatisiert (das Script ist fertig) eingelesen werden soll. Lediglich von der Umformatierung habe ich keine Ahnung.
Hallo, ich habe eine txt vorliegen, in der sind Kundendaten in folgendem Format:
Der Kopf wiederholt sich ständig (alle paar Datensätze) und soll komplett raus.
außerdem besteht er wie im Beispiel aus den ersten 10 Zeilen und wie man sieht taucht er wieder auf.
die entstehende Tabelle soll dann so aussehen:
Ich wäre wahnsinnig froh, wenn mir jemand helfen kann, ich bin leider nicht so bewandert in VBA.
in der Tabelle ist ersichtlich, dass pro Person 2 Zeilen in Excel gebraucht werden
Der Kopf soll nur 1 einziges mal ganz oben stehen und dann auch nur so, wie unten
Die Anzahl der Datensätze umfasst ca 50.000
Falls Fragen noch dazu sind, oder Sie vielleicht nur teilweise weiterhelfen können, dann wäre das schon sehr hilfreich.
mit freundlichem Gruß
ein vollkommen verzweifelter VBA-Neuling
PS: die Daten hier sind alle frei erfunden
Hallo, ich habe eine txt vorliegen, in der sind Kundendaten in folgendem Format:
Tages-Datum: 05.01.08 Zeit: 02:25 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Stand: 05.01.08
Empfänger: 5350 XXXXXXXXXXXXXXXXXXXXXXXXX Job : GLOQ0000
Liste: LQRXXXXX Bestände obligatorisch Seite: 001
************************************************************************************************************************************
Versicherung: Sachsen aktuelle Währung: EUR
=============
Vertrags-Nr.
Name/ G Geb-Dat. Zut.Dat. Vers.- Vers.Summe Beitrag Brutto Beitrag Netto Endbeitrag
Adresse Beginn Risiko-Zuschlag Bardividende Kostenerst.
---------------------------- - -------- -------- -------- --------------- --------------- --------------- ---------------
01xxxxxx-04
Muster, UWE M 06.06.55 05.04 30.05.04 1.300,00 12,44 7,46 5,54
WALDSIEDLUNG 17a 0,00 4,98 1,92
19322 WITTENBERGE
01xxxxxx-03
Muster, MARIO M 14.01.55 09.03 30.09.03 2.600,00 15,34 9,20 5,78
WALDSIEDLUNG 233 0,00 6,14 3,42
16909 WITTSTOCK
01xxxxxx-03
Muster, HELMUT M 29.08.55 12.04 11.01.05 1.000,00 11,42 6,85 5,29
WALDSIEDLUNG 21 0,00 4,57 1,56
08525 PLAUEN
01xxxxxx-03
Muster, UWE M 01.10.55 08.07 30.08.07 4.000,00 20,52 12,31 7,19
WALDSIEDLUNG 23 0,00 8,21 5,12
04651 HOPFGARTEN
01xxxxxx-04
Muster, WALDEMAR M 05.01.55 12.05 30.12.05 5.700,00 77,24 46,34 36,88
WALDSIEDLUNG 16 0,00 30,90 9,46
39261 ZERBST
01xxxxxx-03
Muster, DORIS W 11.01.55 06.05 30.06.05 3.800,00 25,42 16,52 11,39
WALDSIEDLUNG 17 0,00 8,90 5,13
17207 RÖBEL/MÜRITZ
01xxxxxx-03
Muster, ANDREA W 23.02.55 06.05 02.08.05 7.500,00 41,10 26,71 16,99
WALDSIEDLUNG 15 0,00 14,39 9,72
09456 ANNABERG-BUCHHOLZ
01xxxxxx-02
Muster, ANDREAS M 14.02.55 06.07 30.06.07 1.800,00 11,43 6,86 4,46
WALDSIEDLUNG 14 0,00 4,57 2,40
01129 DRESDEN
01xxxxxx-02
Muster, WOLFGANG M 17.06.55 08.07 30.08.07 1.600,00 18,27 10,96 8,46
WALDSIEDLUNG 13 0,00 7,31 2,50
01589 RIESA
01xxxxxx-05
Muster, KARL M 03.02.55 10.07 30.10.07 1.500,00 18,68 11,21 8,79
WALDSIEDLUNG 12 0,00 7,47 2,42
06779 RAGUHN
Tages-Datum: 05.01.08 Zeit: 02:25 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Stand: 05.01.08
Empfänger: 5350 XXXXXXXXXXXXXXXXXXXXXXXXX Job : GLOQ0000
Liste: LQRXXXXX Bestände obligatorisch Seite: 002
************************************************************************************************************************************
Versicherung: Sachsen aktuelle Währung: EUR
=============
Vertrags-Nr.
Name/ G Geb-Dat. Zut.Dat. Vers.- Vers.Summe Beitrag Brutto Beitrag Netto Endbeitrag
Adresse Beginn Risiko-Zuschlag Bardividende Kostenerst.
---------------------------- - -------- -------- -------- --------------- --------------- --------------- ---------------
01xxxxxx-05
Muster, INGO M 06.10.55 04.07 04.06.07 10.700,00 63,13 37,88 23,80
WALDSIEDLUNG 11 0,00 25,25 14,08
06638 KARSDORF
01xxxxxx-02
Muster, FRED M 28.03.55 11.06 30.01.07 3.200,00 21,95 13,17 8,82
WALDSIEDLUNG 10 0,00 8,78 4,35
14947 NUTHE-URSTROMTAL außerdem besteht er wie im Beispiel aus den ersten 10 Zeilen und wie man sieht taucht er wieder auf.
die entstehende Tabelle soll dann so aussehen:
| Vertragsnummer | Name | Vorname | Straße | Postleitzahl | Ort | G | Geb.-Dat. | Zut.Dat. | Vers.-Beginn | Vers.Summe | Beitrag Brutto | Beitrag Netto | Endbetrag |
| Risiko Zuschlag | Bardividende | Kostenerst. | |||||||||||
| 01xxxxxx-05 | Muster | Ingo | Waldsiedlung 11 | 06638 | Karsdorf | M | 06.10.55 | 04.07 | 04.06.07 | 10.700,00 | 63,13 | 37,88 | 23,80 |
| 0,00 | 25,25 | 14,08 |
Ich wäre wahnsinnig froh, wenn mir jemand helfen kann, ich bin leider nicht so bewandert in VBA.
in der Tabelle ist ersichtlich, dass pro Person 2 Zeilen in Excel gebraucht werden
Der Kopf soll nur 1 einziges mal ganz oben stehen und dann auch nur so, wie unten
Die Anzahl der Datensätze umfasst ca 50.000
Falls Fragen noch dazu sind, oder Sie vielleicht nur teilweise weiterhelfen können, dann wäre das schon sehr hilfreich.
mit freundlichem Gruß
ein vollkommen verzweifelter VBA-Neuling
PS: die Daten hier sind alle frei erfunden
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 93504
Url: https://administrator.de/contentid/93504
Ausgedruckt am: 23.11.2024 um 10:11 Uhr
6 Kommentare
Neuester Kommentar
Hallo tommygun und willkommen im Forum!
Die naheliegendste und sinnvollste Möglichkeit, die Quelldaten in einem vernünftig verarbeitbaren Format erhalten zu können, dürfte vermutlich ausscheiden, daher also tatsächlich Plan B (Umformatierung) ...
Vorweg eine Überlegung zur Struktur der Ergebnisdaten: Abhängig davon, welche Excel-Version verwendet werden soll und ob mit "Anzahl der Datensätze" die Zeilenanzahl in der Textdatei oder die tatsächliche Zahl der Kundendatensätze gemeint ist, wäre zu beachten, dass, im ungünstigsten Fall (Excel < 2007, 50000 Datensätze à 2 Zeilen), ein Import an der zu geringen Zeilenanzahl einer Exceltabelle scheitern könnte ...
... daher folgender Vorschlag: Zusammenfassung der Felder eines Datensatzes in einer Zeile einer neu zu erstellenden Text-(CSV-)Datei mit nachfolgendem Import.
Das (etwas schütter kommentierte
) Script könnte etwa so aussehen:
Anzupassen wären in erster Linie die Pfade der Dateien - die übrigen Angaben orientieren sich an der Beschreibung im Beitrag.
Das Script erwartet eine Quelldatei mit dem beschriebenen Aufbau: Kopfbereiche zu je 10 Zeilen, Datenblöcke zu je 4 Zeilen, Trennung der Datenblöcke durch Leerzeilen
Erstellt werden eine Datei mit nicht verwendeten Zeilen (Kopfzeilen, Leerzeilen - zur Dokumentation), sowie eine Datei mit einer Überschriftszeile und jeweils einer Zeile Nutzdaten, getrennt durch das angegebene Trennzeichen (derzeit ";").
Beim Import der Nutzdaten ist auf das Feld "Zut.Dat." zu achten, da dieses als Datum interpretiert wird - es kann aber (im dritten Schritt des Assistenten) der Datentyp explizit auf "Text" gesetzt werden (was sich auch als Makro aufzeichnen lässt).
Eine Anpassung auf das vorgeschlagene zweizeilige Importformat ist (im Rahmen der oben genannten Überlegungen) möglich - allerdings widerstrebt es mir etwas, ein schlecht weiterzuverarbeitendes Format durch ein anderes zu ersetzen ...
Grüße
bastla
Die naheliegendste und sinnvollste Möglichkeit, die Quelldaten in einem vernünftig verarbeitbaren Format erhalten zu können, dürfte vermutlich ausscheiden, daher also tatsächlich Plan B (Umformatierung) ...
Vorweg eine Überlegung zur Struktur der Ergebnisdaten: Abhängig davon, welche Excel-Version verwendet werden soll und ob mit "Anzahl der Datensätze" die Zeilenanzahl in der Textdatei oder die tatsächliche Zahl der Kundendatensätze gemeint ist, wäre zu beachten, dass, im ungünstigsten Fall (Excel < 2007, 50000 Datensätze à 2 Zeilen), ein Import an der zu geringen Zeilenanzahl einer Exceltabelle scheitern könnte ...
... daher folgender Vorschlag: Zusammenfassung der Felder eines Datensatzes in einer Zeile einer neu zu erstellenden Text-(CSV-)Datei mit nachfolgendem Import.
Das (etwas schütter kommentierte
) Script könnte etwa so aussehen:Sub ReOrg()
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Lines
'##### Beginn Anpassung #####
Lines = Split(fso.OpenTextFile("D:\Liste.txt").ReadAll, vbCrLf) 'Quelldaten einlesen
Set Discard = fso.CreateTextFile("D:\Ausgeschieden.txt", True)
Set Dat = fso.CreateTextFile("D:\Nutzdaten.txt", True)
Header = LCase("Tages-Datum:")
LH = 10 'Zeilenanzahl Header
LD = 4 'Zeilenanzahl Quelldaten
ColsW = Array(28, 1, 8, 8, 8, 15, 15, 15, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile
FD = 16 'Feldanzahl Ergebnissatz
Delim = ";" 'Trennzeichen Ergebnissatz
Dim Data() 'Datenfelder des Ergebnissatzes - Werte
Dim Fields(16) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert)
Fields( 0) = Array(0, 0) 'Zeile 0, Feld 0 = Vertragsnummer
Fields( 1) = Array(1, 0) 'Name - vor Aufteilung
Fields( 2) = Array(1, 0) 'Vorname - vor Aufteilung
Fields( 3) = Array(2, 0) 'Zeile 2, Feld 0 = Straße
Fields( 4) = Array(3, 0) 'PLZ - vor Aufteilung
Fields( 5) = Array(3, 0) 'Ort - vor Aufteilung
Fields( 6) = Array(1, 1) 'Geschlecht
Fields( 7) = Array(1, 2)
Fields( 8) = Array(1, 3)
Fields( 9) = Array(1, 4)
Fields(10) = Array(1, 5)
Fields(11) = Array(1, 6)
Fields(12) = Array(1, 7)
Fields(13) = Array(1, 8)
Fields(14) = Array(2, 5)
Fields(15) = Array(2, 6)
Fields(16) = Array(2, 7)
'##### Ende Anpassung #####
UCols = UBound(ColsW) 'Anzahl Spalten
ColsS = ColsW
ColsS(0) = 1 'Startposition erstes Feld in Zeile (nicht null-basiert)
For i = 1 To UCols
ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld
Next
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen"
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen
ErrorCode = 0 'Flag für fehlerfreien Ablauf
i = 0
Do
If LCase(Left(Lines(i), L)) = Header Then
If i <= (U - LH + 1) Then 'vollständiger Header
For j = 0 To LH - 1
Discard.WriteLine Lines(i + j)
Next
i = i + LH - 1
Else
Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1
ErrorCode = 1
i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung
End If
ElseIf Trim(Lines(i)) = "" Then
Discard.WriteLine
Else
If i <= U - LD + 1 Then
ReDim Data(16) 'Datenfelder Ergebnis löschen
For j = 0 To FD 'Datenfelder Ergebnis füllen
Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1))))
Next
'Spezialfälle
'Zerlegung Name und PLZ
Data(1) = Trim(Split(Data(1), ",")(0))
Data(2) = Trim(Split(Data(2), ",")(1))
P = InStr(Data(4), " ") 'Trennung PLZ/Ort durch " "
If P > 0 Then
Data(4) = Trim(Left(Data(4), P))
Data(5) = Trim(Mid(Data(5), P))
Else
'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion?
End If
Dat.WriteLine Join(Data, Delim)
i = i + LD - 1
Else
Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1
ErrorCode = 2
i = U
End If
End If
i = i + 1
Loop While i <= U
Dat.Close
Discard.Close
Select Case ErrorCode
Case 1
MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!"
Case 2
MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!"
End Select
End SubDas Script erwartet eine Quelldatei mit dem beschriebenen Aufbau: Kopfbereiche zu je 10 Zeilen, Datenblöcke zu je 4 Zeilen, Trennung der Datenblöcke durch Leerzeilen
Erstellt werden eine Datei mit nicht verwendeten Zeilen (Kopfzeilen, Leerzeilen - zur Dokumentation), sowie eine Datei mit einer Überschriftszeile und jeweils einer Zeile Nutzdaten, getrennt durch das angegebene Trennzeichen (derzeit ";").
Beim Import der Nutzdaten ist auf das Feld "Zut.Dat." zu achten, da dieses als Datum interpretiert wird - es kann aber (im dritten Schritt des Assistenten) der Datentyp explizit auf "Text" gesetzt werden (was sich auch als Makro aufzeichnen lässt).
Eine Anpassung auf das vorgeschlagene zweizeilige Importformat ist (im Rahmen der oben genannten Überlegungen) möglich - allerdings widerstrebt es mir etwas, ein schlecht weiterzuverarbeitendes Format durch ein anderes zu ersetzen ...
Grüße
bastla
Hallo, vielen Dank
das werde ich morgen gleich implementieren, hier habe ich leider kein Excel zuhause.
wenn weitere Fragen auftauchen werde ich mich morgen hier melden, ansonsten schließe ich den Thread wenn alles geklappt hat.
Vielen, vielen Dank nochmals
mit freundlichem Gruß
tommygun
//edit:
Hallo, ich habe es gleich getestet und Wahnsinn. es funktioniert super, ich werde es noch ein wenig anpassen, da das Resultat ja eine Exceltabelle sein soll, die Entstehung der neuen sortierten txt, die auch gleich enorm kleiner wird habe ich meinem Chef vorgeschlagen, er sieht das als sinnvolle Ergänzung.
Ich bin begeistert und hoffe ich kann zukünftig dem Forum mein Wissen beisteuern (was nicht VBA ist :D)
Danke nochmals, ich lasse den Thread noch ungelöst, bis die Implementierung komplett ist, nur für den Fall der Fälle.
das werde ich morgen gleich implementieren, hier habe ich leider kein Excel zuhause.
wenn weitere Fragen auftauchen werde ich mich morgen hier melden, ansonsten schließe ich den Thread wenn alles geklappt hat.
Vielen, vielen Dank nochmals
mit freundlichem Gruß
tommygun
//edit:
Hallo, ich habe es gleich getestet und Wahnsinn. es funktioniert super, ich werde es noch ein wenig anpassen, da das Resultat ja eine Exceltabelle sein soll, die Entstehung der neuen sortierten txt, die auch gleich enorm kleiner wird habe ich meinem Chef vorgeschlagen, er sieht das als sinnvolle Ergänzung.
Ich bin begeistert und hoffe ich kann zukünftig dem Forum mein Wissen beisteuern (was nicht VBA ist :D)
Danke nochmals, ich lasse den Thread noch ungelöst, bis die Implementierung komplett ist, nur für den Fall der Fälle.
Hallo, ich habe jetzt das nahezu gleiche Problem, nur dass die txt leicht anders aufgebaut ist. Dazu habe ich Ihren Code eigentlich richtig angepasst, die Ausgabe stimmt leider nicht.
Diesmal sind die Blöcke bloß 3 Zeilen lang und immer mit einer Zeile komplett Leerzeichen getrennt, der Kopf wiederholt sich ebenfalls unregelmäßig bis zum Schluss, ich gehe davon aus, dass das Array nicht stimmt, nur ich weiß nicht mehr wie ich es noch anpassen muss
Den Code habe ich so abgeändert:
die Erstellung der txts geht ja, nur überspringt er Zeilen, die ich brauche und er schreibt beim Namen irgendwelche Zahlen davor.
Für erneute kurze Hilfe währe ich sehr dankbar,
mit freundlichem Gruß
tommy
Diesmal sind die Blöcke bloß 3 Zeilen lang und immer mit einer Zeile komplett Leerzeichen getrennt, der Kopf wiederholt sich ebenfalls unregelmäßig bis zum Schluss, ich gehe davon aus, dass das Array nicht stimmt, nur ich weiß nicht mehr wie ich es noch anpassen muss
Tages-Datum: 03.04.08 Zeit: 03:01 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Stand: 03.04.08
Empfänger: 5350 XXXXXXXXXXXXXXXXXXXXXXXXX Job : GLOQ0505
Liste: LQRV62K3 Abgänge obligatorisch Seite: 001
************************************************************************************************************************************
Versicherung: xxxx aktuelle Währung: EUR
=============
Vertrags-Nr. Vers.-Beginn Name/Adresse Geschlecht Geb.-Datum Endbeitrag
------------ ------------ ------------------------------------------- ---------- ---------- ---------------
01XXXXXX-05 11.01.2008 MUSTERXXX, MUSTERXXXXX M 12.12.1912 -08,80
MUSTERWEG 22
14550 GROß KREUTZ (HAVEL) Den Code habe ich so abgeändert:
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Lines
Lines = Split(fso.OpenTextFile(dlgLBS.txtDat2.Value).ReadAll, vbCrLf) 'Quelldaten einlesen
Set Discard = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".junk.txt", True) 'Auswurf
Set Dat = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".cleaned.txt", True) 'Ausgabe
Header = LCase("Tages-Datum:") 'damit beginnt jeder Header
LH = 8 'Zeilenanzahl Header
Footer = LCase(" davon weiblich") 'damit Prüfung ob Footer
LD = 3 'Zeilenanzahl Quelldaten
ColsW = Array(12, 12, 43, 10, 10, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile
FD = 9 'Feldanzahl Ergebnissatz
Delim = ";" 'Trennzeichen Ergebnissatz
Dim Data() 'Datenfelder des Ergebnissatzes - Werte
Dim Fields(9) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert)
Fields(0) = Array(0, 0) 'Vertragsnummer
Fields(1) = Array(0, 1) 'Vers.-Beginn
Fields(2) = Array(0, 2) 'Name - vor Aufteilung
Fields(3) = Array(0, 2) 'Vorname - vor Aufteilung
Fields(4) = Array(0, 3) 'G
Fields(5) = Array(0, 4) 'Geb-Dat.
Fields(6) = Array(0, 5) 'Endbeitrag
Fields(7) = Array(1, 2) 'Straße
Fields(8) = Array(2, 2) 'PLZ - vor Aufteilung
Fields(9) = Array(2, 2) 'Ort - vor Aufteilung
UCols = UBound(ColsW) 'Anzahl Spalten
ColsS = ColsW
ColsS(0) = 1 'Startposition ersten Feld in Zeile (nicht null-basiert)
For i = 1 To UCols
ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld
Next
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen"
F = Len(Footer)
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen
ErrorCode = 0 'Flag für fehlerfreien Ablauf
i = 0
Do
If LCase(Left(Lines(i), F)) = Footer Then
i = U 'Ende der Bearbeitung
End If
If LCase(Left(Lines(i), L)) = Header Then
If i <= (U - LH + 1) Then 'vollständiger Header
For j = 0 To LH - 1
Discard.WriteLine Lines(i + j)
Next
i = i + LH - 1
Else
Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1
ErrorCode = 1
i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung
End If
ElseIf Trim(Lines(i)) = "" Then
Discard.WriteLine
Else
If i <= U - LD + 1 Then
ReDim Data(9) 'Datenfelder Ergebnis löschen
For j = 0 To FD 'Datenfelder Ergebnis füllen
Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1))))
Next
'Spezialfälle
'Zerlegung Name und PLZ
Data(2) = Trim(Split(Data(2), ",")(0))
Data(3) = Trim(Split(Data(3), ",")(1))
P = InStr(Data(8), " ") 'Trennung PLZ/Ort durch " "
If P > 0 Then
Data(8) = Trim(Left(Data(8), P))
Data(9) = Trim(Mid(Data(9), P))
Else
'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion?
End If
Dat.WriteLine Join(Data, Delim)
i = i + LD - 1
Else
Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1
ErrorCode = 2
i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung
End If
End If
i = i + 1
Loop While i <= U
Dat.Close
Discard.Close
Select Case ErrorCode
Case 1
MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!"
Case 2
MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!"
End Selectdie Erstellung der txts geht ja, nur überspringt er Zeilen, die ich brauche und er schreibt beim Namen irgendwelche Zahlen davor.
Für erneute kurze Hilfe währe ich sehr dankbar,
mit freundlichem Gruß
tommy
Hallo tommygun!
Da hier die einzelnen Spalten nicht nur durch ein Leerzeichen getrennt sind, ergeben sich die Spaltenbreiten einfach aus "Zeichenanzahl bis zum Beginn der nächsten Spalte -1) - siehe dazu Zeile 14.
Die neu hinzugefügte Berücksichtigung des Footers muss in die allgemeine Unterscheidung der Möglichkeiten einbezogen werden, daher nicht mit "End If" abschließen, sondern die nächste Abfrage mit "ElseIf" gleich unmittelbar anfügen. Außerdem sollten (der Ordnung halber) die dadurch wegfallenden Zeilen ebenfalls in "junk.txt" landen.
So könnte das dann klappen:
Grüße
bastla
Da hier die einzelnen Spalten nicht nur durch ein Leerzeichen getrennt sind, ergeben sich die Spaltenbreiten einfach aus "Zeichenanzahl bis zum Beginn der nächsten Spalte -1) - siehe dazu Zeile 14.
Die neu hinzugefügte Berücksichtigung des Footers muss in die allgemeine Unterscheidung der Möglichkeiten einbezogen werden, daher nicht mit "End If" abschließen, sondern die nächste Abfrage mit "ElseIf" gleich unmittelbar anfügen. Außerdem sollten (der Ordnung halber
) die dadurch wegfallenden Zeilen ebenfalls in "junk.txt" landen.So könnte das dann klappen:
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Lines
Lines = Split(fso.OpenTextFile(dlgLBS.txtDat2.Value).ReadAll, vbCrLf) 'Quelldaten einlesen
Set Discard = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".junk.txt", True) 'Auswurf
Set Dat = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".cleaned.txt", True) 'Ausgabe
Header = LCase("Tages-Datum:") 'damit beginnt jeder Header
LH = 8 'Zeilenanzahl Header
Footer = LCase(" davon weiblich") 'damit Prüfung ob Footer
LD = 3 'Zeilenanzahl Quelldaten
ColsW = Array(16, 13, 44, 11, 11, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile
FD = 9 'Feldanzahl Ergebnissatz
Delim = ";" 'Trennzeichen Ergebnissatz
Dim Data() 'Datenfelder des Ergebnissatzes - Werte
Dim Fields(9) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert)
Fields(0) = Array(0, 0) 'Vertragsnummer
Fields(1) = Array(0, 1) 'Vers.-Beginn
Fields(2) = Array(0, 2) 'Name - vor Aufteilung
Fields(3) = Array(0, 2) 'Vorname - vor Aufteilung
Fields(4) = Array(0, 3) 'G
Fields(5) = Array(0, 4) 'Geb-Dat.
Fields(6) = Array(0, 5) 'Endbeitrag
Fields(7) = Array(1, 2) 'Straße
Fields(8) = Array(2, 2) 'PLZ - vor Aufteilung
Fields(9) = Array(2, 2) 'Ort - vor Aufteilung
UCols = UBound(ColsW) 'Anzahl Spalten
ColsS = ColsW
ColsS(0) = 1 'Startposition erstes Feld in Zeile (nicht null-basiert)
For i = 1 To UCols
ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld
Next
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen"
F = Len(Footer)
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen
ErrorCode = 0 'Flag für fehlerfreien Ablauf
i = 0
Do
If LCase(Left(Lines(i), F)) = Footer Then
For j = i To U
Discard.WriteLine Lines(j)
Next
i = U 'Ende der Bearbeitung
ElseIf LCase(Left(Lines(i), L)) = Header Then
If i <= (U - LH + 1) Then 'vollständiger Header
For j = 0 To LH - 1
Discard.WriteLine Lines(i + j)
Next
i = i + LH - 1
Else
Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1
ErrorCode = 1
i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung
End If
ElseIf Trim(Lines(i)) = "" Then
Discard.WriteLine
Else
If i <= U - LD + 1 Then
ReDim Data(9) 'Datenfelder Ergebnis löschen
For j = 0 To FD 'Datenfelder Ergebnis füllen
Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1))))
Next
'Spezialfälle
'Zerlegung Name und PLZ
Data(2) = Trim(Split(Data(2), ",")(0))
Data(3) = Trim(Split(Data(3), ",")(1))
P = InStr(Data(8), " ") 'Trennung PLZ/Ort durch " "
If P > 0 Then
Data(8) = Trim(Left(Data(8), P))
Data(9) = Trim(Mid(Data(9), P))
Else
'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion?
End If
Dat.WriteLine Join(Data, Delim)
i = i + LD - 1
Else
Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1
ErrorCode = 2
i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung
End If
End If
i = i + 1
Loop While i <= U
Dat.Close
Discard.Close
Select Case ErrorCode
Case 1
MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!"
Case 2
MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!"
End Selectbastla
Guten Morgen, ich hab mich gleich rangemacht und es funktioniert super. Ich werde mir mit Voraussicht darauf, dass bald mehr von den VBA Aufgaben auf mich einstürzen ein paar Modifikationen vornehmen und schauen, wie das dann funktioniert um Ihren Code endgültig zu verstehen und nicht ständig fragen zu müssen.
Vielen Dank dass Sie sich die Zeit genommen haben.
Mit freundlichem Gruß
tommygun
Vielen Dank dass Sie sich die Zeit genommen haben.
Mit freundlichem Gruß
tommygun
Hallo tommygun!
).
Grüße
bastla
... um Ihren Code endgültig zu verstehen ...
Leider muss ich zugeben, dass die Kommentierung (von Dokumentation will ich gleich gar nicht sprechen) noch immer sehr spärlich ist ...... und nicht ständig fragen zu müssen.
... aber nicht nur deshalb: Fragen kostet hier nichts (es kann nur etwas dauern bis zur Antwort ).Grüße
bastla
