Fehletrhaftes vbs Script. Werte werden falsch ausgelesen bzw. geschrieben. Kann mir hier jemand helfen?

Hallo,

ich habe eine csv Datei die wie folgt aufgebaut ist

Test;name
20309;
20309;
20309;we
20309;te
20309;er
20309;ei
20309;ws
20309;si
10030;
10030;ei
10030;ws
10030;si
10030;

habe hierzu ein script gefunden, welches mir die Werte nebeneinander schreibt

Ein = "c:\temp\funktion.csv"  
Aus = "C:\Quelle\funktion_neu.csv"  
Delim = ";"  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set d = CreateObject("Scripting.Dictionary")  

T = Split(fso.OpenTextFile(Ein).ReadAll, vbNewLine)
Ueber = Split(T(0), Delim)(0) 'erstes Feld der ersten Zeile übernehmen  
For i = 1 To UBound(T) 'Bezeichnungen sammeln  
    If Trim(T(i)) <> "" Then 'keine Leerzeile verarbeiten  
        Bez = Split(T(i), Delim)(1) 'zweites Feld der Datenzeile lesen ...  
        If Bez <> "" Then  
            If Not d.Exists(Bez) Then '... und falls noch nicht vorhanden ...  
                Ueber = Ueber & Delim & Bez '... der Überschrift hinzufügen  
                Index = Index + 1 'Index für Felder hochzählen  
                d.Add Bez, Index 'Bezeichnung und Index in Dictionary hinzufügen  
            End If
        End If
    End If
Next

Daten = Ueber 'Ausgabe beginnt mit Überschrift  
Dim Felder 'Array initialisieren  
ReDim Felder(Index)
For j = 1 To Index: Felder(j) = 0: Next 'Feldwerte auf 0 setzen  
For i = 1 To UBound(T) 'alle Datenzeilen verarbeiten  
    If Trim(T(i)) <> "" Then 'keine Leerzeile verarbeiten  
        Bez = Split(T(i), Delim)(1) 'zweites Feld der Datenzeile lesen  
        Nr = Split(T(i), Delim)(0) 'erstes Feld der Datenzeile lesen ...  
        If Nr = Zuletzt Then '... und prüfen, ob noch gleiche Nummer  
            FeldIndex = d.Item(Bez) 'Index für Bezeichnung ermitteln  
            Felder(FeldIndex) = Felder(FeldIndex) - 1  'Anzahl erhöhen  
        Else
            If i > 1 Then 'nicht erste Zeile, ...  
                Daten = Daten & vbNewLine & Join(Felder, Delim) 'Datensatz der Ausgabe hinzufügen  
            End If
            For j = 1 To Index: Felder(j) = 0: Next 'Feldwerte auf 0 setzen  
            Felder(0) = Nr '... und Nr für neuen Satz eintragen  
            FeldIndex = d.Item(Bez) 'Index für Bezeichnung ermitteln  
            Felder(FeldIndex) = Felder(FeldIndex) - 1 'Anzahl erhöhen  
        End If
        Zuletzt = Nr
    End If
Next
Daten = Daten & vbNewLine & Join(Felder, Delim) 'letzten Datensatz der Ausgabe hinzufügen  
fso.CreateTextFile(Aus).Write Daten 'Ausgabedatei schreiben  

aber Anstatt
Test;We;Te;Er;Ei;Ws;Si;
20309;-1;-1;-1;-1;-1;1
10030;0;0;0;-1;-1;-1

schreibt er

Test;We;Te;Er;Ei;Ws;Si;
20307;-1;-1;-1;-1;-1;1
10038;0;0;0;-1;-1;-1

Warum verändert er den Wert 20309 in 20307
bzw. 10030 ind 10038

es werden alle Werte in dern eu geschriebenen Datei verändert
Kann mir dieses nicht erklären, daher hoffe ich, jemand kann den Fehler erkennen.

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 203115

Url: https://administrator.de/forum/fehletrhaftes-vbs-script-werte-werden-falsch-ausgelesen-bzw-geschrieben-kann-mir-hier-jemand-helfen-203115.html

Ausgedruckt am: 10.04.2025 um 02:04 Uhr

2 Kommentare

Neuester Kommentar

Hi,

hab das ganze mal getestet und bei mir kommt am Ende wieder was anderes raus :D
den Fehler hab ich jetzt leider nicht gefunden, werde aber weitersuchen ;)

Ausgabe bei mir:

Test;we;te;er;ei;ws;si
20307;-1;-1;-1;-1;-1;-1
10028;0;0;0;-1;-1;-1

Grüße
Exzellius

Hallo thomas1972!

Bei einem leeren zweiten Feld im Datensatz ergibt sich ein FeldIndex von 0, und da in Felder(0) die Zeilenbezeichnung steht, wird diese um 1 vermindert - mit dieser Version sollte das nicht mehr passieren:

Ein = "c:\temp\funktion.csv"  
Aus = "C:\Quelle\funktion_neu.csv"  
Delim = ";"  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set d = CreateObject("Scripting.Dictionary")  

T = Split(fso.OpenTextFile(Ein).ReadAll, vbNewLine)
Ueber = Split(T(0), Delim)(0) 'erstes Feld der ersten Zeile übernehmen  
For i = 1 To UBound(T) 'Bezeichnungen sammeln  
    If Trim(T(i)) <> "" Then 'keine Leerzeile verarbeiten  
        Bez = Split(T(i), Delim)(1) 'zweites Feld der Datenzeile lesen ...  
        If Bez <> "" Then  
            If Not d.Exists(Bez) Then '... und falls noch nicht vorhanden ...  
                Ueber = Ueber & Delim & Bez '... der Überschrift hinzufügen  
                Index = Index + 1 'Index für Felder hochzählen  
                d.Add Bez, Index 'Bezeichnung und Index in Dictionary hinzufügen  
            End If
        End If
    End If
Next

Daten = Ueber 'Ausgabe beginnt mit Überschrift  
Dim Felder 'Array initialisieren  
ReDim Felder(Index)
For j = 1 To Index: Felder(j) = 0: Next 'Feldwerte auf 0 setzen  
For i = 1 To UBound(T) 'alle Datenzeilen verarbeiten  
    If Trim(T(i)) <> "" Then 'keine Leerzeile verarbeiten  
        Bez = Split(T(i), Delim)(1) 'zweites Feld der Datenzeile lesen  
        Nr = Split(T(i), Delim)(0) 'erstes Feld der Datenzeile lesen ...  
        If Nr = Zuletzt Then '... und prüfen, ob noch gleiche Nummer  
            If Bez <> "" Then  
                FeldIndex = d.Item(Bez) 'Index für Bezeichnung ermitteln  
                Felder(FeldIndex) = Felder(FeldIndex) - 1  'Anzahl erhöhen  
            End If
        Else
            If i > 1 Then 'nicht erste Zeile, ...  
                Daten = Daten & vbNewLine & Join(Felder, Delim) 'Datensatz der Ausgabe hinzufügen  
            End If
            For j = 1 To Index: Felder(j) = 0: Next 'Feldwerte auf 0 setzen  
            Felder(0) = Nr '... und Nr für neuen Satz eintragen  
            If Bez <> "" Then  
                FeldIndex = d.Item(Bez) 'Index für Bezeichnung ermitteln  
                Felder(FeldIndex) = Felder(FeldIndex) - 1 'Anzahl erhöhen  
            End If
        End If
        Zuletzt = Nr
    End If
Next
Daten = Daten & vbNewLine & Join(Felder, Delim) 'letzten Datensatz der Ausgabe hinzufügen  
fso.CreateTextFile(Aus).Write Daten 'Ausgabedatei schreiben  