Per batch oder vbs script csv dateien aufgliedern Ohne EXCEL

Hallo an das Forum,

ich habe div. cvs Dateien, welche ich nicht per Excel sonder per Batch weiterverarbeiten möchte
bzw. wie ich diese in Access direkt richtig aufgebaut bekomme.

Die Dateien sind unterschiedlich aufgebaut, daher mal 2 Beispiele wie Sie aussehen können und was ich erreichen möchte

Beispiel 1

Zeile 1 ist Überschrift die durch ; getrennt ist
Ab Zeile 2 Werte die durch ; getrennt sind

Nummer;Bezeichnung
4566;Michael
4566;Kerstin
4566;Thomas
4566;Simone
4566:Dirk
3333;Kerstin
3333;Thomas
3333;Simone
9876;
6788;Simone
6788:Dirk

Nun soll aus dem gefunden Wert ab der 2 Zeile die Bezeichnung übernommen werden
und diese in die erste Zeile getrennt mit ; eingebunden
gleichzeitig soll der Wert entweder 1 oder 0 sein.

Nummer;Michael;Kerstin;Thomas;Simone;Dirk
4566;1;1;1;1;1
3333;0;1;1;0;0
9876;0;0;0;0;0
6788;0;0;0;1;1

andere Möglichkeit der Aufbau einer ander Datei

Nummer;Zahl1;Zahl2;Zahl3;Artikel
123;9;5;A
123;9;2;D
123;9;3;G
456;34;23;D
654:57;23;D
654:57;26;G

Nummer;Zahl1;A;D;G
123;9;5;2;3
456;34;;23;
654;57;23;26

Vielleicht hat hier jemand eine Hilfestellung per VBS für mich.
Eine Lösung über Access habe ich nicht gefunden. Die Kreuztabellen kommt als Lösung nicht in Frage, da die Zeilen alle unterschiedlich aufgebaut sind und ich in den Kreuztabellen max 1 Spalte und 1 Zeile angeben kann, ich aber mehr Spalten hintereinander stehen haben muss

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

Content-ID: 190561

Url: https://administrator.de/contentid/190561

Ausgedruckt am: 22.11.2024 um 00:11 Uhr

10 Kommentare

Neuester Kommentar

Hallo intermde!

Lässt sich zwar vermutlich noch eleganter lösen, aber als Anhaltspunkt ein Ansatz für Beispiel 1:

Ein = "Beispiel1.csv"  
Aus = "Beispiel1_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  
WScript.Echo "Fertig."  

Ich bin davon ausgegangen, dass Deine Originaldaten keine fehlerhaften Trennzeichen (wie die "Dirk"-Zeilen im Beispiel) aufweisen und nach Nummern sortiert vorliegen ...

Grüße
bastla

Hallo intermde, bastla!

Lässt sich zwar vermutlich noch eleganter lösen, aber als Anhaltspunkt ein Ansatz für Beispiel 1:

Eventuell so?

Option Explicit

Const Ein = "E:\Beispiel1_Ein.csv"  
Const Aus = "E:\Beispiel1_Aus.csv"  
Const Delim = ";"  
    
Dim oFso, oCsv, aCsvHead, aTarget, aToken, aText, aCsvItems, sCsvHead, sCsvText, sName, i

Set oFso = CreateObject("Scripting.FileSystemObject")  
Set oCsv = CreateObject("Scripting.Dictionary")  
    
'Alle Textzeilen einlesen  
aText = Split(oFso.openTextFile(Ein).ReadAll, vbCrLf)
    
'1. Feldname übernehmen  
sCsvHead = Split(aText(0), Delim)(0)
    
'Alle restlichen Feldnamen ermitteln und übernehmen  
For i = 1 To UBound(aText)
    If InStr(aText(i), Delim) > 0 Then
        sName = Trim(Split(aText(i), Delim)(1))
        If InStr(1, sCsvHead, sName, vbTextCompare) <= 0 Then
            sCsvHead = sCsvHead & Delim & sName
        End If
    End If
Next
    
'Array mit Csv-Feldnamen erzeugen  
aCsvHead = Split(sCsvHead, Delim)
    
'Array mit Csv-Spalten erzeugen  
ReDim aToken(UBound(aCsvHead))
    
'Spalten-Array mit 0 initialisieren  
For i = 0 To UBound(aToken):  aToken(i) = 0:  Next
    
'Überschrift in Dictionary übernehmen  
oCsv.Add "CsvHead", aCsvHead  
    
'Restliche Textzeilen auslesen und auswerten  
For i = 1 To UBound(aText)
    If InStr(aText(i), Delim) > 0 Then      'Test Textzeile enthält Trennzeichen  
        aTarget = Split(aText(i), Delim)    'Array mit Nummer und Namen  
        If oCsv.Exists(aTarget(0)) Then     'Test ob Nummer schon existiert  
            'Wenn Nummer existiert, dann Name in Spalte XY = 1  
            oCsv.Item(aTarget(0)) = GetCsvItems(oCsv.Item(aTarget(0)), aTarget(1))
        Else
            aToken(0) = aTarget(0)  'Spalte 1 = Nummer  
            'Wenn neue Nummer, dann Nummer in Spalte 1 und Name in Spalte XY = 1  
            oCsv.Add aTarget(0), GetCsvItems(aToken, aTarget(1))
        End If
    End If
Next
   
'Dictionary auslesen und Csv-Zeilen in Text-String schreiben  
For Each aCsvItems In oCsv.Items
    sCsvText = sCsvText & Join(aCsvItems, Delim) & vbCrLf
Next
    
'Csv-Zeilen in Datei schreiben  
oFso.CreateTextFile(Aus).Write sCsvText

Function GetCsvItems(ByVal aCsvItems, ByRef sName)
    Dim i
    
    'Namen in der Überschriftzeile suchen und in Spalte XY eine 1 eintragen  
    For i = 1 To UBound(aCsvItems)
        If LCase(Trim(aCsvHead(i))) = LCase(Trim(sName)) Then
            aCsvItems(i) = 1:  Exit For
        End If
    Next

    GetCsvItems = aCsvItems
End Function

Gruß Dieter

Hallo, danke euch beiden,

ich werde es in meinen weiteren Daten berücksichtne und anpassen,

würde mir nur ein Hinweis auf mein Beispiel 2 fehlen...

"....
andere Möglichkeit der Aufbau einer anderen Datei

Nummer;Zahl1;Zahl2;Zahl3;Artikel
123;9;5;A
123;9;2;D
123;9;3;G
456;34;23;D
654:57;23;D
654:57;26;G

Nummer;Zahl1;A;D;G
123;9;5;2;3
456;34;;23;
654;57;23;26

..."

vielleicht kann hier nochmal Basla oder Dieter drüber schauen, wünsche euch ein schönes Wochenende

Hallo intermde!

Sollte in etwa so gehen:

Option Explicit

Const Ein = "E:\Ein2.csv"  
Const Aus = "E:\Aus2.csv"  
Const Delim = ";"  
    
Dim oFso, oCsv, aCsvHead, aTarget, aToken, aText, aCsvItems, sCsvHead, sCsvText, sArtikel, sKey, i

Set oFso = CreateObject("Scripting.FileSystemObject")  
Set oCsv = CreateObject("Scripting.Dictionary")  
    
'Alle Textzeilen einlesen  
aText = Split(oFso.openTextFile(Ein).ReadAll, vbCrLf)
    
'Array mit den Feldnamen  
aTarget = Split(aText(0), Delim)
    
'1. und 2. Feldname übernehmen  
sCsvHead = aTarget(0) & Delim & aTarget(1)
    
'Alle restlichen Feldnamen ermitteln und übernehmen  
For i = 1 To UBound(aText)
    If InStr(aText(i), Delim) > 0 Then
        sArtikel = "#" & Trim(Split(aText(i), Delim)(3))  
        If InStr(1, sCsvHead, sArtikel, vbTextCompare) <= 0 Then
            sCsvHead = sCsvHead & Delim & sArtikel
        End If
    End If
Next
    
'Array mit Csv-Feldnamen erzeugen  
aCsvHead = Split(Replace(sCsvHead, "#", ""), Delim)  
    
'Array mit Csv-Spalten erzeugen  
ReDim aToken(UBound(aCsvHead))
    
'Spalten-Array mit 0 initialisieren  
For i = 0 To UBound(aToken):  aToken(i) = 0:  Next
    
'Überschrift in Dictionary übernehmen  
oCsv.Add "CsvHead", aCsvHead  
    
'Restliche Textzeilen auslesen und auswerten  
For i = 1 To UBound(aText)
    If InStr(aText(i), Delim) > 0 Then          'Test Textzeile enthält Trennzeichen  
        aTarget = Split(aText(i), Delim)        'Array mit Nummer und Zahl1  
        sKey = aTarget(0) & "$" & aTarget(1)    'Key = Nummer + $ + Zahl1  
        If oCsv.Exists(sKey) Then     'Test ob Nummer mit Zahl1 schon existiert  
            'Wenn Nummer mit Zahl1 existiert, dann Name in Spalte XY = Zahl?  
            oCsv.Item(sKey) = GetCsvItems(oCsv.Item(sKey), aTarget(2), aTarget(3))
        Else
            aToken(0) = aTarget(0)  'Spalte 1 = Nummer  
            aToken(1) = aTarget(1)  'Spalte 2 = Zahl1  
            'Wenn neue Nummer mit Zahl1, dann Spalte Artikel XY = Anzahl  
            oCsv.Add sKey, GetCsvItems(aToken, aTarget(2), aTarget(3))
        End If
    End If
Next
   
'Dictionary auslesen und Csv-Zeilen in Text-String schreiben  
For Each aCsvItems In oCsv.Items
    sCsvText = sCsvText & Join(aCsvItems, Delim) & vbCrLf
Next
    
'Csv-Zeilen in Datei schreiben  
oFso.CreateTextFile(Aus).Write sCsvText


Function GetCsvItems(ByVal aCsvItems, ByVal iAnzahl, ByRef sArtikel)
    Dim i
    
    'Artikel in der Überschriftzeile suchen und in Spalte XY die Anzahl eintragen  
    For i = 2 To UBound(aCsvItems)
        If LCase(Trim(aCsvHead(i))) = LCase(Trim(sArtikel)) Then
            aCsvItems(i) = iAnzahl:  Exit For
        End If
    Next

    GetCsvItems = aCsvItems
End Function

Wobei für Nummer mit unterschiedlicher Zahl1 (falls gegeben) eine neue Csv-Zeile erzeugt wird

Ergebnis:

Nummer;Zahl1;A;D;G
123;9;5;2;3
456;34;0;23;0
654;57;0;23;26

Gruß Dieter

Hallo Dieter,

vielen Dank für die Hilestellung,

habe hier zwar das problem mit dem Wert 0

habs aber einfach mit einem weiteren Script gelöst, welches ich einfach im Anschluss laufen lasse

Datei = "c:\temp\test.csv"  
Set fso = CreateObject("Scripting.FileSystemObject")  
T = fso.OpenTextFile(Datei).ReadAll
fso.CreateTextFile(Datei).Write Replace(T, ";0", ";")  

Danke nochmal für die Hilfe

Hallo nochmal...
sorry, wenn ich die Frage noch nicht geschlossen habe.

Hab noch 4 Dateien mit folgendem Aufbau gefunden, die Frage ist wie kann ich o.g. Scripte den Bedürfnissen anpassen?

Der Aufbau ist ähnlich

Überschrift 1; Überschrif 2; Überschrift 3
3456;Name1;Wert1
3456;Name2;Wert2
3456;Name3;Wert3
6789;Name1;Wert4
6789;Name2;Wert5
6789;Name3;Wert6

Daraus soll werden

Überschrift 1; Name1; Name2; Name3....
3456;Wert1;Wert2;Wert3
6789;Wert4;Wert5;Wert6

Sprich übernehme den ersten Wert, generiere aus dem nachfolgenden Bereich die Überschriften
und übernehme dann den Werte aus dem letzen Bereich.

Der NameX kann unterschiedlich sein, es gibt für diesen NamenX aber immer einen WertX.
Der WertX kann Text aber auch Nummerisch sein.

Wünsche allen einen schönen Sonntag

Hallo intermde!

Wenn Du die Nullen nicht magst, dann ließe sich das in Skript 2 einfach ändern, indem Du die Codezeile 38 durch diese ersetzt:

    For i = 0 To UBound(aToken):  aToken(i) = "":  Next

Für Dein letztes Beispiel eignet sich Skript 1, wobei bei sich nur 4 Codezeilen (46, 50, 63, 69) ändern:

 oCsv.Item(aTarget(0)) = GetCsvItems(oCsv.Item(aTarget(0)), aTarget(1), aTarget(2))
 oCsv.Add aTarget(0), GetCsvItems(aToken, aTarget(1), aTarget(2))
 Function GetCsvItems(ByVal aCsvItems, ByRef sName, ByRef sValue)
 aCsvItems(i) = sValue:  Exit For  

Gruß Dieter