Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

txt-Datei in Excel öffnen und dabei umformatieren mit einem Makro

Frage Entwicklung VB for Applications

Mitglied: tommygun

tommygun (Level 1) - Jetzt verbinden

04.08.2008, aktualisiert 09.12.2008, 4702 Aufrufe, 6 Kommentare

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:
01.
Tages-Datum: 05.01.08  Zeit: 02:25    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                                Stand: 05.01.08  
02.
Empfänger:   5350                                       XXXXXXXXXXXXXXXXXXXXXXXXX                                    Job  : GLOQ0000  
03.
Liste: LQRXXXXX                              Bestände                 obligatorisch                                  Seite:      001  
04.
************************************************************************************************************************************  
05.
Versicherung: Sachsen                                   aktuelle Währung:  EUR                                                        
06.
=============                                                                                                                         
07.
Vertrags-Nr.                                                                                                                          
08.
Name/                        G  Geb-Dat. Zut.Dat.  Vers.-      Vers.Summe  Beitrag Brutto  Beitrag Netto       Endbeitrag             
09.
Adresse                                            Beginn Risiko-Zuschlag    Bardividende    Kostenerst.                              
10.
---------------------------- - -------- -------- -------- --------------- --------------- --------------- ---------------             
11.
01xxxxxx-04                                                                                                                           
12.
Muster, UWE                  M 06.06.55   05.04  30.05.04        1.300,00           12,44            7,46            5,54             
13.
WALDSIEDLUNG 17a                                                     0,00            4,98            1,92                             
14.
19322 WITTENBERGE                                                                                                                     
15.
                                                                                                                                      
16.
01xxxxxx-03                                                                                                                           
17.
Muster, MARIO                M 14.01.55   09.03  30.09.03        2.600,00           15,34            9,20            5,78             
18.
WALDSIEDLUNG 233                                                     0,00            6,14            3,42                             
19.
16909 WITTSTOCK                                                                                                                       
20.
                                                                                                                                      
21.
01xxxxxx-03                                                                                                                           
22.
Muster, HELMUT               M 29.08.55   12.04  11.01.05        1.000,00           11,42            6,85            5,29             
23.
WALDSIEDLUNG 21                                                      0,00            4,57            1,56                             
24.
08525 PLAUEN                                                                                                                          
25.
                                                                                                                                      
26.
01xxxxxx-03                                                                                                                           
27.
Muster, UWE                  M 01.10.55   08.07  30.08.07        4.000,00           20,52           12,31            7,19             
28.
WALDSIEDLUNG 23                                                      0,00            8,21            5,12                             
29.
04651 HOPFGARTEN                                                                                                                      
30.
                                                                                                                                      
31.
01xxxxxx-04                                                                                                                           
32.
Muster, WALDEMAR             M 05.01.55   12.05  30.12.05        5.700,00           77,24           46,34           36,88             
33.
WALDSIEDLUNG 16                                                      0,00           30,90            9,46                             
34.
39261 ZERBST                                                                                                                          
35.
                                                                                                                                      
36.
01xxxxxx-03                                                                                                                           
37.
Muster, DORIS                W 11.01.55   06.05  30.06.05        3.800,00           25,42           16,52           11,39             
38.
WALDSIEDLUNG 17                                                      0,00            8,90            5,13                             
39.
17207 RÖBEL/MÜRITZ                                                                                                                    
40.
                                                                                                                                      
41.
01xxxxxx-03                                                                                                                           
42.
Muster, ANDREA               W 23.02.55   06.05  02.08.05        7.500,00           41,10           26,71           16,99             
43.
WALDSIEDLUNG 15                                                      0,00           14,39            9,72                             
44.
09456 ANNABERG-BUCHHOLZ                                                                                                               
45.
                                                                                                                                      
46.
01xxxxxx-02                                                                                                                           
47.
Muster, ANDREAS              M 14.02.55   06.07  30.06.07        1.800,00           11,43            6,86            4,46             
48.
WALDSIEDLUNG 14                                                      0,00            4,57            2,40                             
49.
01129 DRESDEN                                                                                                                         
50.
                                                                                                                                      
51.
01xxxxxx-02                                                                                                                           
52.
Muster, WOLFGANG             M 17.06.55   08.07  30.08.07        1.600,00           18,27           10,96            8,46             
53.
WALDSIEDLUNG 13                                                      0,00            7,31            2,50                             
54.
01589 RIESA                                                                                                                           
55.
                                                                                                                                      
56.
01xxxxxx-05                                                                                                                           
57.
Muster, KARL                 M 03.02.55   10.07  30.10.07        1.500,00           18,68           11,21            8,79             
58.
WALDSIEDLUNG 12                                                      0,00            7,47            2,42                             
59.
06779 RAGUHN                                                                                                                          
60.
                                                                                                                                      
61.
Tages-Datum: 05.01.08  Zeit: 02:25    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                                Stand: 05.01.08  
62.
Empfänger:   5350                                       XXXXXXXXXXXXXXXXXXXXXXXXX                                    Job  : GLOQ0000  
63.
Liste: LQRXXXXX                              Bestände                 obligatorisch                                  Seite:      002  
64.
************************************************************************************************************************************  
65.
Versicherung: Sachsen                                   aktuelle Währung:  EUR                                                        
66.
=============                                                                                                                         
67.
Vertrags-Nr.                                                                                                                          
68.
Name/                        G  Geb-Dat. Zut.Dat.  Vers.-      Vers.Summe  Beitrag Brutto  Beitrag Netto       Endbeitrag             
69.
Adresse                                            Beginn Risiko-Zuschlag    Bardividende    Kostenerst.                              
70.
---------------------------- - -------- -------- -------- --------------- --------------- --------------- ---------------             
71.
01xxxxxx-05                                                                                                                           
72.
Muster, INGO                 M 06.10.55   04.07  04.06.07       10.700,00           63,13           37,88           23,80             
73.
WALDSIEDLUNG 11                                                      0,00           25,25           14,08                             
74.
06638 KARSDORF                                                                                                                        
75.
                                                                                                                                      
76.
01xxxxxx-02                                                                                                                           
77.
Muster, FRED                 M 28.03.55   11.06  30.01.07        3.200,00           21,95           13,17            8,82             
78.
WALDSIEDLUNG 10                                                      0,00            8,78            4,35                             
79.
14947 NUTHE-URSTROMTAL                                                                                                               
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:
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
Mitglied: bastla
04.08.2008 um 14:41 Uhr
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:
01.
Sub ReOrg() 
02.
Set fso = CreateObject("Scripting.FileSystemObject") 
03.
 
04.
Dim Lines 
05.
'##### Beginn Anpassung ##### 
06.
Lines = Split(fso.OpenTextFile("D:\Liste.txt").ReadAll, vbCrLf) 'Quelldaten einlesen 
07.
Set Discard = fso.CreateTextFile("D:\Ausgeschieden.txt", True) 
08.
Set Dat = fso.CreateTextFile("D:\Nutzdaten.txt", True) 
09.
 
10.
Header = LCase("Tages-Datum:") 
11.
LH = 10 'Zeilenanzahl Header 
12.
 
13.
LD = 4 'Zeilenanzahl Quelldaten 
14.
ColsW = Array(28, 1, 8, 8, 8, 15, 15, 15, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile 
15.
 
16.
FD = 16 'Feldanzahl Ergebnissatz 
17.
Delim = ";" 'Trennzeichen Ergebnissatz 
18.
Dim Data() 'Datenfelder des Ergebnissatzes - Werte 
19.
Dim Fields(16) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert) 
20.
Fields( 0) = Array(0, 0) 'Zeile 0, Feld 0 = Vertragsnummer 
21.
Fields( 1) = Array(1, 0) 'Name - vor Aufteilung 
22.
Fields( 2) = Array(1, 0) 'Vorname - vor Aufteilung 
23.
Fields( 3) = Array(2, 0) 'Zeile 2, Feld 0 = Straße 
24.
Fields( 4) = Array(3, 0) 'PLZ - vor Aufteilung 
25.
Fields( 5) = Array(3, 0) 'Ort - vor Aufteilung 
26.
Fields( 6) = Array(1, 1) 'Geschlecht 
27.
Fields( 7) = Array(1, 2) 
28.
Fields( 8) = Array(1, 3) 
29.
Fields( 9) = Array(1, 4) 
30.
Fields(10) = Array(1, 5) 
31.
Fields(11) = Array(1, 6) 
32.
Fields(12) = Array(1, 7) 
33.
Fields(13) = Array(1, 8) 
34.
Fields(14) = Array(2, 5) 
35.
Fields(15) = Array(2, 6) 
36.
Fields(16) = Array(2, 7) 
37.
'##### Ende Anpassung ##### 
38.
 
39.
UCols = UBound(ColsW) 'Anzahl Spalten 
40.
ColsS = ColsW 
41.
ColsS(0) = 1 'Startposition erstes Feld in Zeile (nicht null-basiert) 
42.
For i = 1 To UCols 
43.
    ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld 
44.
Next 
45.
 
46.
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen" 
47.
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen 
48.
 
49.
ErrorCode = 0 'Flag für fehlerfreien Ablauf 
50.
 
51.
i = 0 
52.
Do 
53.
    If LCase(Left(Lines(i), L)) = Header Then 
54.
        If i <= (U - LH + 1) Then 'vollständiger Header 
55.
            For j = 0 To LH - 1 
56.
                Discard.WriteLine Lines(i + j) 
57.
            Next 
58.
            i = i + LH - 1 
59.
        Else 
60.
            Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1 
61.
            ErrorCode = 1 
62.
            i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung 
63.
        End If 
64.
    ElseIf Trim(Lines(i)) = "" Then 
65.
        Discard.WriteLine 
66.
    Else 
67.
        If i <= U - LD + 1 Then 
68.
            ReDim Data(16) 'Datenfelder Ergebnis löschen 
69.
            For j = 0 To FD 'Datenfelder Ergebnis füllen 
70.
                Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1)))) 
71.
            Next 
72.
            'Spezialfälle 
73.
            'Zerlegung Name und PLZ 
74.
            Data(1) = Trim(Split(Data(1), ",")(0)) 
75.
            Data(2) = Trim(Split(Data(2), ",")(1)) 
76.
            P = InStr(Data(4), " ") 'Trennung PLZ/Ort durch " " 
77.
            If P > 0 Then 
78.
                Data(4) = Trim(Left(Data(4), P)) 
79.
                Data(5) = Trim(Mid(Data(5), P)) 
80.
            Else 
81.
                'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion? 
82.
            End If 
83.
            Dat.WriteLine Join(Data, Delim) 
84.
            i = i + LD - 1 
85.
        Else 
86.
            Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1 
87.
            ErrorCode = 2 
88.
            i = U 
89.
        End If 
90.
    End If 
91.
    i = i + 1 
92.
Loop While i <= U 
93.
Dat.Close 
94.
Discard.Close 
95.
 
96.
Select Case ErrorCode 
97.
Case 1 
98.
    MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!" 
99.
Case 2 
100.
    MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!" 
101.
End Select 
102.
End Sub
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
Bitte warten ..
Mitglied: tommygun
04.08.2008 um 17:17 Uhr
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.
Bitte warten ..
Mitglied: tommygun
08.12.2008 um 14:28 Uhr
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

01.
Tages-Datum: 03.04.08  Zeit: 03:01    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX                                Stand: 03.04.08  
02.
Empfänger:   5350                                       XXXXXXXXXXXXXXXXXXXXXXXXX                                    Job  : GLOQ0505  
03.
Liste: LQRV62K3                              Abgänge                  obligatorisch                                  Seite:      001  
04.
************************************************************************************************************************************  
05.
Versicherung: xxxx                                   aktuelle Währung:  EUR                                                           
06.
=============                                                                                                                         
07.
Vertrags-Nr.     Vers.-Beginn  Name/Adresse                                 Geschlecht  Geb.-Datum       Endbeitrag                   
08.
------------     ------------  -------------------------------------------  ----------  ----------  ---------------                   
09.
01XXXXXX-05       11.01.2008   MUSTERXXX, MUSTERXXXXX                            M      12.12.1912           -08,80                   
10.
                               MUSTERWEG 22                                                                                           
11.
                               14550 GROß KREUTZ (HAVEL)                                                                             
Den Code habe ich so abgeändert:
01.
Set fso = CreateObject("Scripting.FileSystemObject") 
02.
 
03.
Dim Lines 
04.
Lines = Split(fso.OpenTextFile(dlgLBS.txtDat2.Value).ReadAll, vbCrLf) 'Quelldaten einlesen 
05.
Set Discard = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".junk.txt", True)  'Auswurf 
06.
Set Dat = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".cleaned.txt", True)  'Ausgabe 
07.
 
08.
Header = LCase("Tages-Datum:")  'damit beginnt jeder Header 
09.
LH = 8 'Zeilenanzahl Header 
10.
 
11.
Footer = LCase("       davon weiblich") 'damit Prüfung ob Footer 
12.
 
13.
LD = 3 'Zeilenanzahl Quelldaten 
14.
ColsW = Array(12, 12, 43, 10, 10, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile 
15.
 
16.
FD = 9 'Feldanzahl Ergebnissatz 
17.
Delim = ";" 'Trennzeichen Ergebnissatz 
18.
Dim Data() 'Datenfelder des Ergebnissatzes - Werte 
19.
Dim Fields(9) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert) 
20.
Fields(0) = Array(0, 0)  'Vertragsnummer 
21.
Fields(1) = Array(0, 1)  'Vers.-Beginn 
22.
Fields(2) = Array(0, 2)  'Name - vor Aufteilung 
23.
Fields(3) = Array(0, 2)  'Vorname - vor Aufteilung 
24.
Fields(4) = Array(0, 3)  'G 
25.
Fields(5) = Array(0, 4)  'Geb-Dat. 
26.
Fields(6) = Array(0, 5)  'Endbeitrag 
27.
Fields(7) = Array(1, 2)  'Straße 
28.
Fields(8) = Array(2, 2)  'PLZ - vor Aufteilung 
29.
Fields(9) = Array(2, 2)  'Ort - vor Aufteilung 
30.
 
31.
UCols = UBound(ColsW) 'Anzahl Spalten 
32.
ColsS = ColsW 
33.
ColsS(0) = 1 'Startposition ersten Feld in Zeile (nicht null-basiert) 
34.
For i = 1 To UCols 
35.
    ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld 
36.
Next 
37.
 
38.
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen" 
39.
F = Len(Footer) 
40.
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen 
41.
 
42.
ErrorCode = 0 'Flag für fehlerfreien Ablauf 
43.
 
44.
i = 0 
45.
Do 
46.
    If LCase(Left(Lines(i), F)) = Footer Then 
47.
    i = U 'Ende der Bearbeitung 
48.
    End If 
49.
    If LCase(Left(Lines(i), L)) = Header Then 
50.
        If i <= (U - LH + 1) Then 'vollständiger Header 
51.
            For j = 0 To LH - 1 
52.
                Discard.WriteLine Lines(i + j) 
53.
            Next 
54.
            i = i + LH - 1 
55.
        Else 
56.
            Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1 
57.
            ErrorCode = 1 
58.
            i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung 
59.
        End If 
60.
    ElseIf Trim(Lines(i)) = "" Then 
61.
        Discard.WriteLine 
62.
    Else 
63.
        If i <= U - LD + 1 Then 
64.
            ReDim Data(9) 'Datenfelder Ergebnis löschen 
65.
            For j = 0 To FD 'Datenfelder Ergebnis füllen 
66.
                Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1)))) 
67.
            Next 
68.
            'Spezialfälle 
69.
            'Zerlegung Name und PLZ 
70.
            Data(2) = Trim(Split(Data(2), ",")(0)) 
71.
            Data(3) = Trim(Split(Data(3), ",")(1)) 
72.
            P = InStr(Data(8), " ") 'Trennung PLZ/Ort durch " " 
73.
            If P > 0 Then 
74.
                Data(8) = Trim(Left(Data(8), P)) 
75.
                Data(9) = Trim(Mid(Data(9), P)) 
76.
            Else 
77.
                'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion? 
78.
            End If 
79.
            Dat.WriteLine Join(Data, Delim) 
80.
            i = i + LD - 1 
81.
        Else 
82.
            Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1 
83.
            ErrorCode = 2 
84.
            i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung 
85.
        End If 
86.
    End If 
87.
    i = i + 1 
88.
Loop While i <= U 
89.
Dat.Close 
90.
Discard.Close 
91.
 
92.
Select Case ErrorCode 
93.
Case 1 
94.
    MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!" 
95.
Case 2 
96.
    MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!" 
97.
End Select
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
Bitte warten ..
Mitglied: bastla
08.12.2008 um 20:07 Uhr
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:
01.
Set fso = CreateObject("Scripting.FileSystemObject") 
02.
 
03.
Dim Lines 
04.
Lines = Split(fso.OpenTextFile(dlgLBS.txtDat2.Value).ReadAll, vbCrLf) 'Quelldaten einlesen 
05.
Set Discard = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".junk.txt", True)  'Auswurf 
06.
Set Dat = fso.CreateTextFile(dlgLBS.txtDat2.Value + ".cleaned.txt", True)  'Ausgabe 
07.
 
08.
Header = LCase("Tages-Datum:")  'damit beginnt jeder Header 
09.
LH = 8 'Zeilenanzahl Header 
10.
 
11.
Footer = LCase("       davon weiblich") 'damit Prüfung ob Footer 
12.
 
13.
LD = 3 'Zeilenanzahl Quelldaten 
14.
ColsW = Array(16, 13, 44, 11, 11, 15) 'Spaltenbreiten (ohne folgendes Trennzeichen " ") in Quelldatenzeile 
15.
 
16.
FD = 9 'Feldanzahl Ergebnissatz 
17.
Delim = ";" 'Trennzeichen Ergebnissatz 
18.
Dim Data() 'Datenfelder des Ergebnissatzes - Werte 
19.
Dim Fields(9) 'Datenfeld - Positionen (jeweils Zeilen- und Spaltennr der Quelldatenblocks; null-basiert) 
20.
Fields(0) = Array(0, 0)  'Vertragsnummer 
21.
Fields(1) = Array(0, 1)  'Vers.-Beginn 
22.
Fields(2) = Array(0, 2)  'Name - vor Aufteilung 
23.
Fields(3) = Array(0, 2)  'Vorname - vor Aufteilung 
24.
Fields(4) = Array(0, 3)  'G 
25.
Fields(5) = Array(0, 4)  'Geb-Dat. 
26.
Fields(6) = Array(0, 5)  'Endbeitrag 
27.
Fields(7) = Array(1, 2)  'Straße 
28.
Fields(8) = Array(2, 2)  'PLZ - vor Aufteilung 
29.
Fields(9) = Array(2, 2)  'Ort - vor Aufteilung 
30.
 
31.
UCols = UBound(ColsW) 'Anzahl Spalten 
32.
ColsS = ColsW 
33.
ColsS(0) = 1 'Startposition erstes Feld in Zeile (nicht null-basiert) 
34.
For i = 1 To UCols 
35.
    ColsS(i) = ColsS(i - 1) + ColsW(i - 1) + 1 'Startposition abhängig von vorhergehendem Feld 
36.
Next 
37.
 
38.
L = Len(Header) 'Länge des Kennzeichens für "Kopfzeilen" 
39.
F = Len(Footer) 
40.
U = UBound(Lines) 'Anzahl eingelesener Quelldatenzeilen 
41.
 
42.
ErrorCode = 0 'Flag für fehlerfreien Ablauf 
43.
 
44.
i = 0 
45.
Do 
46.
    If LCase(Left(Lines(i), F)) = Footer Then 
47.
        For j = i To U 
48.
            Discard.WriteLine Lines(j) 
49.
        Next 
50.
        i = U 'Ende der Bearbeitung 
51.
    ElseIf LCase(Left(Lines(i), L)) = Header Then 
52.
        If i <= (U - LH + 1) Then 'vollständiger Header 
53.
            For j = 0 To LH - 1 
54.
                Discard.WriteLine Lines(i + j) 
55.
            Next 
56.
            i = i + LH - 1 
57.
        Else 
58.
            Discard.WriteLine "Unvollständiger Header ab Zeile " & i + 1 
59.
            ErrorCode = 1 
60.
            i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung 
61.
        End If 
62.
    ElseIf Trim(Lines(i)) = "" Then 
63.
        Discard.WriteLine 
64.
    Else 
65.
        If i <= U - LD + 1 Then 
66.
            ReDim Data(9) 'Datenfelder Ergebnis löschen 
67.
            For j = 0 To FD 'Datenfelder Ergebnis füllen 
68.
                Data(j) = Trim(Mid(Lines(i + Fields(j)(0)), ColsS(Fields(j)(1)), ColsW(Fields(j)(1)))) 
69.
            Next 
70.
            'Spezialfälle 
71.
            'Zerlegung Name und PLZ 
72.
            Data(2) = Trim(Split(Data(2), ",")(0)) 
73.
            Data(3) = Trim(Split(Data(3), ",")(1)) 
74.
            P = InStr(Data(8), " ") 'Trennung PLZ/Ort durch " " 
75.
            If P > 0 Then 
76.
                Data(8) = Trim(Left(Data(8), P)) 
77.
                Data(9) = Trim(Mid(Data(9), P)) 
78.
            Else 
79.
                'Aufteilung PLZ/Ort mangels Trennzeichen nicht möglich - Reaktion? 
80.
            End If 
81.
            Dat.WriteLine Join(Data, Delim) 
82.
            i = i + LD - 1 
83.
        Else 
84.
            Dat.WriteLine "Unvollständiger Datenblock ab Zeile " & i + 1 
85.
            ErrorCode = 2 
86.
            i = U 'Zeilenzähler auf Dateiende setzen - dadurch Ende der Bearbeitung 
87.
        End If 
88.
    End If 
89.
    i = i + 1 
90.
Loop While i <= U 
91.
Dat.Close 
92.
Discard.Close 
93.
 
94.
Select Case ErrorCode 
95.
Case 1 
96.
    MsgBox "Die Quelldatei enthält einen unvollständigen Header!", vbCritical, "Fehler!" 
97.
Case 2 
98.
    MsgBox "Die Quelldatei enthält einen unvollständigen Datenblock!", vbCritical, "Fehler!" 
99.
End Select
Grüße
bastla
Bitte warten ..
Mitglied: tommygun
09.12.2008 um 05:53 Uhr
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
Bitte warten ..
Mitglied: bastla
09.12.2008 um 07:49 Uhr
Hallo tommygun!

... 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
Bitte warten ..
Neuester Wissensbeitrag
Ähnliche Inhalte
Microsoft Office
gelöst CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen (5)

Frage von JoSiBa zum Thema Microsoft Office ...

Batch & Shell
Batch-Variable nach Stichworten aus TXT Datei durchsuchen (3)

Frage von Markus5579 zum Thema Batch & Shell ...

Webentwicklung
gelöst HTML Output in eine txt Datei mit VisualBasicScript (2)

Frage von coca22COCA zum Thema Webentwicklung ...

Batch & Shell
Merkwürdige Zeilenformatierung in txt Datei (3)

Frage von miczar zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (23)

Frage von patz223 zum Thema Windows Userverwaltung ...

Viren und Trojaner
Aufgepasst: Neue Ransomware Goldeneye verbreitet sich rasant (20)

Link von Penny.Cilin zum Thema Viren und Trojaner ...

LAN, WAN, Wireless
FritzBox, zwei Server, verschiedene Netze (19)

Frage von DavidGl zum Thema LAN, WAN, Wireless ...

Windows Netzwerk
Windows 10 RDP geht nicht (18)

Frage von Fiasko zum Thema Windows Netzwerk ...