Anzeige

[VBS] 2 Textdateien zusammenführen anhand einer ID


#1
Hallo zusammen,

ich möchte gerne zwei Textdateien (.csv oder .txt) zusammenführen, wobei die Inhalte nicht einfach untereinander stehen sollen, sondern Zeilen anhand einer ID zusammengeführt werden sollen.

Beispiel

Datei1.csv:

ID|Name
123|Thomas
789|Marco
456|Michael


Datei2.csv:

Wohnort|ID|Strasse
Hamburg|456|Wassergasse 1
München|123|Kirchweg 90
Berlin|789|Hauptstrasse 4
München|123|Mittelweg 3

Zusammengeführte CSV-Datei:

ID|Name|Wohnort|Strasse
123|Thomas|München|Kirchweg 90
123|Thomas|München|Mittelweg 3
789|Marco|Berlin|Hauptstrasse 4
456|Michael|Berlin|Hauptstrasse 4


Es sollen also alle zusammengehörigen Datensätze in einer Zeile der neuen CSV-Datei zusammengeführt werden.

Hat jemand eine Lösung bzw. einen Lösungsansatz wie sich das in VBScript (nicht VB oder VBA!) vernünftig umsetzen lässt?

Danke und viele Grüße
Tom
 
#2
Macht es Sinn die Textdateien zeilenweise in jeweils ein array einzulesen, die arrays anhand der ID zu sortieren und dann zeilenweise in die neue Datei zuschreiben?

Wenn ja wie kann ich die Zusammenführung in einer Schleife realisieren?
 

Yaslaw

n/a
Moderator
#3
Der Ansatz ist nicht schlecht. Ich würde mit Dictionaries arbeiten.

Ich habe lange nicht mehr mit VBS programmiert. Muss man da die Variablen Deklarieren? Ansonsten nimmst du die entsprechenden Zeilen raus.

Ungetestet:
Visual Basic:
Const C_DELIMETIER = ";"

Dim dict1 As Object
Dim dict2 As Object
Dim fso As Object
Dim streamOut as Object
Dim id As Long

Set fso = CreateObject("Scripting.FileSystemObject")
Set dict1 = readFile("C:\Datei1.csv", fso)
Set dict2 = readFile("C:\Datei2.csv", fso)

'ForWriting = 2
Set streamOut = fso.OpenTextFile("C:\Datei3.csv", 2)

For Each id In dict1.Keys
    If dict2.exists(id) Then
        streamOut.WriteLine dict1(id) & C_DELIMETIER & dict2(id).line
    End If
Next id
streamOut.close


function readFile(byVal iPath As String, byRef fso As Object) As Object
    Dim streamIn As Object
    Dim line As String
    Dim colNames() As String
    Dim colNr As Long
    Dim id As Long

    'ForReading = 1
    Set streamIn = fso.OpenTextFile(iPath, ForReading)

    Set readFile = CreateObject("scripting.Dictionary")

    'Header auslesen
    line = streamIn.ReadLine
    'Spaltennummer der ID-SPalte ermitteln
    colNames = split(line, C_DELIMETIER)
    For colNr = 0 To uBound(colNames)
        If uCase(colNames(colNr)) = "ID" Then Exit For
    Next colNr

    Do While Not streamIn.AtEndOfStream
        line = streamIn.ReadLine
        'ID Auselesen
        id =  cLng(split(line, C_DELIMETIER)(colNr))
        readFile.add id, line
    Loop
    streamIn.close
End Function
 
#4
Hallo Yaslaw,

vielen Dank für deine Rückmeldung. Wie immer eine wahrscheinlich perfekte Lösung. Nur leider in VBA und nicht VBS. Leider fehlt mir das Wissen zu den unterschieden der beiden Sprachen. Ich versuche das mal in Ruhe zu übersetzen.

Danke
Tom
 
#5
Hallo zusammen,

nachdem mir die Übersetzung deines (Yaslaw) VB-Codes zu aufwändig war und ich mich nicht in die Dictionary-Thematik einarbeiten wollte habe ich das nun doch selbst in VBS runtergeschrieben.

Der Vollständigkeit halber hier der exemplarische Aufbau einer Datendatei die vom Skript verarbeitet wird (test.csv):
Code:
KD;Name;Anzahl;wiederholung
123;Thomas;5;11
456;Sandra;3;7
789;Klaus;9;1
Ich hoffe der Code hilft anderen mit gleicher oder ähnlicher Herausforderung weiter.

Code:
dim fso

set fso = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1
Const ForWriting = 2

'********************'

dim hauptpfad
dim eingangsdatei
dim trennzeichen
dim spaltenauswahl
dim ausgangsdatei

hauptpfad = "C:\VBS\"
' "test.csv" durch eigenen Dateinamen ersetzen
eingangsdatei = hauptpfad & "test.csv"
' falls die Textdatei ein anderes Trennzeichen verwendet (z.B. ein Komma) kann dies hier eingestellt werden
trennzeichen = ";"
' "wiederholung" durch eigenen Spaltennamen ersetzen (den Spaltennamen eintragen der die Anzahl der Wiederholungen einer Zeile vorgibt)
spaltenauswahl = "wiederholung"
' "datendatei_neu.csv" durch eigenen Dateinamen ersetzen, falls gewünscht
ausgangsdatei = hauptpfad & "datendatei_neu.csv"

'********************'

dim eingabe, ausgabe
dim zeile, inhalt, teilen
dim i, d, spaltennr, j

'Original-Datendatei  zum Lesen öffnen
set eingabe = fso.OpenTextFile(eingangsdatei, ForReading)
'Neue Datendatei erstellen und zum Schreiben öffnen
set ausgabe = fso.OpenTextFile(ausgangsdatei, ForWriting, True)


'Textdatei zeilenweise einlesen
Do while not eingabe.AtEndOfStream
    'Aktuelle Zeilennummer ermitteln
    zeile = eingabe.Line
   
    'Zeile einlesen
    inhalt = eingabe.ReadLine
   
    'Zeile in Array splitten anhand vorgegebenem Trennzeichen
    teilen = split(inhalt, trennzeichen)
   
    'Länge des Arrays (Anzahl der Einträge im Array) ermitteln und in Variable speichern
    d = UBound(teilen)
   
    'durch Array (alle Spalten aktueller Zeile) iterieren (von 0 bis Ende des Arrays)
    for i=0 to d
        'nur bei Zeile 1 ausführen
        if ( zeile = 1 ) then
            'wenn Array-Spalte den Suchbegriff beinhaltet...
            if ( teilen(i) = spaltenauswahl ) then
                'aktuelle Array-Nr (Spaltennr) speichern
                spaltennr = i
            end if
        end if
    next
   
    'bei Zeile 1 die komplette Zeile in die neue Textdatei schreiben
    if ( zeile = 1 ) then
        ausgabe.WriteLine inhalt   
    'alle anderen Zeilen x-Fach in die neue Datei schreiben (so oft wie es die oben gesuchte Spalte angibt)
    else
        'Ausgabe x-Fach wiederholen
        for j=1 to teilen(spaltennr)
            ausgabe.WriteLine inhalt
        next
    end if
Loop

eingabe.Close
ausgabe.Close
PS: Natürlich kann auch die Original-Datendatei überschrieben werden. Das kann z.B. erreicht werden in dem man am Ende die Original-Datendatei löscht und die neu erzeugte Datendatei umbenennt (Name der Original-Dateidatei). Am Ende des Codes einfach folgende Zeilen ergänzen.

Code:
fso.DeleteFile(eingangsdatei)
fso.MoveFile ausgangsdatei, eingangsdatei
Danke trotzdem nochmal an dich Yaslaw!

Viele Grüße
Tom
 
#6
Zwar ist mein Skript funktionsfähig und bestimmt für den einen oder anderen hilfreich, nur leider passt es eigentlich nicht zum Thema / zur Fragestellung. Da habe ich zwei Anforderungen von mir vertauscht. Das hier aufgezeigte Skript dupliziert Zeilen x-Fach, während meine Anforderung in diesem Thread war zwei Datendateien miteinander zusammezuführen. Sorry für die Verwirrung. Vielleicht kann ein Moderator das entwirren...?
 
#7
Nachdem mich das Thema weiter beschäftigt hat habe ich nun ein VBScript geschrieben um zwei Dateien anhand von Fremdschlüsseln bzw. Spaltenüberschriften zusammenzuführen. Das Dictionary Objekt in VBS habe ich aktuell noch nicht behirnt bekommen, deshalb habe ich es mit einfachen Schleifen gelöst. Auch ist die Lösung leider nur auf zwei zusammenzuführende Dateien anwendbar. Trotzdem möchte ich euch das Skript nicht vorenthalten.

Vorgaben
Aufbau/Inhalt Datei1:
ID;Name
123;Thomas
456;Marco
789;Nicos
Aufbau/Inhalt Datei2:
KD;Strasse;PLZ;Ort
123;Münchner Str. 16;81549;München
456;Heimatweg 9;85213;Trudering
123;Andere Str. 1;21345;Ort
789;Ouzoweg 25;12345;Musterhausen
Gewünschte Ausgabe
ID;Name;KD_neu;Strasse;PLZ;Ort
123;Thomas;123;Feldmochinger Str. 84;80993;München
123;Thomas;123;Andere;21345;Ort
456;Marco;456;Chammünsterstr;81549;Trudering
789;Nicos;789;Ouzoweg;12345;Musterhausen
Code:
dim fso
set fso = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1
Const ForWriting = 2

dim hauptpfad, eingabedatei1, eingabedatei2, trennzeichen, ausgabedatei

' Pfad zu den Dateien
hauptpfad = "C:\VBS\"
eingabedatei1 = hauptpfad & "datei1.csv"
eingabedatei2 = hauptpfad & "datei2.csv"

' falls die Textdatei ein anderes Trennzeichen verwendet (z.B. ein Komma) kann dies hier eingestellt werden
trennzeichen = ";"

' eigene Spaltennamen eintragen (pro Datei den Spaltennamen eintragen über den die Datensätze zusammengeführt werden sollen)
datenfeldDatei1 = "ID"
datenfeldDatei2 = "KD"

' ggf. eigenen Namen für zusammengeführte Ausgabedatei eintragen
ausgabedatei = hauptpfad & "merged.csv"

dim eingabe1, eingabe2, ausgabe
dim zeileDatei1, inhaltDatei1, arrDatei1, iterationSpaltenDatei1, arrLaengeDatei1, spaltenNrDatei1
dim zeileDatei2, inhaltDatei2, arrDatei2, iterationSpaltenDatei2, arrLaengeDatei2, spaltenNrDatei2

'Datendatei 1 zum Lesen öffnen
set eingabe1 = fso.OpenTextFile(eingabedatei1, ForReading)

'Neue Ausgabe-Datendatei erstellen und zum Schreiben öffnen
set ausgabe = fso.OpenTextFile(ausgabedatei, ForWriting, True)

'Datendatei 1 zeilenweise einlesen
Do while not eingabe1.AtEndOfStream

'Aktuelle Zeilennummer ermitteln
zeileDatei1 = eingabe1.Line

'Zeile einlesen
inhaltDatei1 = eingabe1.ReadLine

'Zeile in Array splitten anhand vorgegebenem Trennzeichen
arrDatei1 = split(inhaltDatei1, trennzeichen)   

'Länge des Arrays (Anzahl der Einträge im Array) ermitteln und in Variable speichern
arrLaengeDatei1 = UBound(arrDatei1)

'Nur bei Zeile 1...
if ( zeileDatei1 = 1 ) then

  '...durch Array (alle Spalten aktueller Zeile) iterieren (von 0 bis Ende des Arrays) - Ermittlung der Spaltennr (Arraynr) mit relevanten Einträgen
  for iterationSpaltenDatei1=0 to arrLaengeDatei1

   'wenn Array-Spalte den Suchbegriff beinhaltet...
   if ( arrDatei1(iterationSpaltenDatei1) = datenfeldDatei1 ) then

    'aktuelle Array-Nr (Spaltennr) speichern
    spaltenNrDatei1 = iterationSpaltenDatei1

   end if

  next

end if

'Die zweite Datendatei zum Lesen öffnen
set eingabe2 = fso.OpenTextFile(eingabedatei2, ForReading)

'Datendatei 2 zeilenweise einlesen
Do while not eingabe2.AtEndOfStream

  'Aktuelle Zeilennummer ermitteln
  zeileDatei2 = eingabe2.Line

  'Zeile einlesen
  inhaltDatei2 = eingabe2.ReadLine

  'Zeile in Array splitten anhand vorgegebenem Trennzeichen
  arrDatei2 = split(inhaltDatei2, trennzeichen)

  'Länge des Arrays (Anzahl der Einträge im Array) ermitteln und in Variable speichern
  arrLaengeDatei2 = UBound(arrDatei2)

  'nur bei Zeile 1 ausführen
  if ( zeileDatei2 = 1 ) then

   'durch Array (alle Spalten aktueller Zeile) iterieren (von 0 bis Ende des Arrays) - Ermittlung der Spaltennr (Arraynr) mit relevanten Einträgen
   for iterationSpaltenDatei2=0 to arrLaengeDatei2

    'wenn Array-Spalte den Suchbegriff beinhaltet...
    if ( arrDatei2(iterationSpaltenDatei2) = datenfeldDatei2 ) then

     'aktuelle Array-Nr (Spaltennr) speichern
     spaltenNrDatei2 = iterationSpaltenDatei2

    end if

   next

  end if

  'nur ausführen wenn sich Schleife in Zeile 1 der Datendatei 1 und in Zeile 1 der Datendatei 2 befindet
  if ( zeileDatei1 = 1 and zeileDatei2 = 1 ) then

   'Spaltennamen von Datei 1 und Datei 2 in Ausgabedatei schreiben (Spaltenname des Fremdschlüssels in der zweiten Datei um "_neu" ergänzen)
   ausgabe.writeline inhaltDatei1 & trennzeichen & Replace(inhaltDatei2, datenfeldDatei2, datenfeldDatei2 & "_neu")

  else

   'nur ausführen wenn der Spalteninhalt der aktuellen Iterationen von Datei 1 und Datei 2 übereinstimmen
   if(arrDatei1(spaltenNrDatei1) = arrDatei2(spaltenNrDatei2)) then

    'Spalteninhalt von Datei 1 und Datei 2 verkettet in Ausgabedateidatei schreiben
    ausgabe.writeline inhaltDatei1 & trennzeichen & inhaltDatei2

   end if

  end if

Loop

'Datei 2 schließen
eingabe2.Close

Loop

'Datei 1 schließen
eingabe1.Close

'Ausgabedatei schließen
ausgabe.Close
Über Verbesserungsvorschläge (z.B. Codeoptimierung, bessere Dynamik, die Möglichkeit mehr als 2 Dateien zusammenzuführen, usw.) würde ich mich sehr freuen.
 

Yaslaw

n/a
Moderator
#9
Doch ein sehr grosse vereinfachung kahm mir über Mittag in den Sinn: ADODB und SQL
Hier ein kleiner Test dazu

Im Ordner wo die Files liegen eine Datei Namens schmea.ini erstellen. Darin beide Dateien definieren. In meinem Fall d1.csv und d2.csv
INI:
[d1.csv]
ColNameHeader=True
Format=Delimited(;)

[d2.csv]
ColNameHeader=True
Format=Delimited(;)
Dann das VBScript
Visual Basic:
Const C_FOLDER_PATH = "C:\_TMP\testVbs\"
Const C_FILE_1 = "d1.csv"
Const C_FILE_2 = "d2.csv"


Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

Dim rst
Dim conn
Dim fso
Dim outPath
Dim outStream
Dim colCount, i
Dim hdr()

'Pfade setzen
Set fso = CreateObject("Scripting.FileSystemObject")

'Outpufile definieren und ggf löschen
outPath = C_FOLDER_PATH &  "out.csv"
If fso.FileExists(outPath) Then fso.DeleteFile outPath, True

'Connection auf denOrdner aufbauen'
Set conn = CreateObject("ADODB.Connection")
conn.provider = "Microsoft.Jet.OLEDB.4.0"
conn.ConnectionString = "Data Source='" & C_FOLDER_PATH & "';Extended Properties='text'" 'HDR=Yes;FMT=Delimited('';'')';"
conn.Open

Set rst = CreateObject("ADODB.recordset")
rst.Open "SELECT t1.*, t2.* FROM " & C_FILE_1 & " AS t1 INNER JOIN " & C_FILE_2 & " AS t2 ON t1.ID = t2.KD", _
    conn, adOpenStatic, adLockOptimistic, adCmdText

'Header herauslesen
colCount = rst.fields.count
ReDim hdr(colCount - 1)
For i = 0 To colCount - 1
    hdr(i) = rst.fields(i).Name
Next

'Out-Stream erstellen
Set outStream = fso.OpenTextFile(outPath, 2, True) ' 2 = ForWriting

'Header schreiben
outStream.writeLine Join(hdr, ";")

'Daten schreiben
'http://www.w3schools.com/asp/met_rs_getstring.asp#stringformatenum
outStream.writeLine rst.GetString(2, , ";")

outStream.Close
Das wars schon. Ach, ich liebe SQL.....

Das eigentliche Herzstück ist
SQL:
SELECT
    t1.*,
    t2.*
FROM
    d1.csv AS t1
    INNER JOIN d2.csv AS t2
        ON t1.ID = t2.KD
Mit dem SQL-Code werden die Quellen dann verknüpft und aufbereitet.

Ich habe den ganzen Test im Zipp angehängt. Nicht vergessen, Pfade etc. anzupassen
 

Anhänge

#10
Hi Yaslaw,

du bist einsame Spitze! Natürlich hat das Skript erstmal nicht funktioniert, da ich ein 64bit System verwende. Ich habe aber ein Code-Snippet gefunden mit dem das Problem gelöst wird. Der Code muss einfach am Anfang des Skripts eingefügt werden. Die Lösung habe ich von hier: http://stackoverflow.com/a/18689528

Code:
   ' ***************
   ' *** 64bit check
   ' ***************
   ' check to see if we are on 64bit OS -> re-run this script with 32bit cscript
   Function RestartWithCScript32(extraargs)
   Dim strCMD, iCount
   strCMD = r32wShell.ExpandEnvironmentStrings("%SYSTEMROOT%") & "\SysWOW64\cscript.exe"
   If NOT r32fso.FileExists(strCMD) Then strCMD = "cscript.exe" ' This may not work if we can't find the SysWOW64 Version
   strCMD = strCMD & Chr(32) & Wscript.ScriptFullName & Chr(32)
   If Wscript.Arguments.Count > 0 Then
    For iCount = 0 To WScript.Arguments.Count - 1
     if Instr(Wscript.Arguments(iCount), " ") = 0 Then ' add unspaced args
      strCMD = strCMD & " " & Wscript.Arguments(iCount) & " "
     Else
      If Instr("/-\", Left(Wscript.Arguments(iCount), 1)) > 0 Then ' quote spaced args
       If InStr(WScript.Arguments(iCount),"=") > 0 Then
        strCMD = strCMD & " " & Left(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), "=") ) & """" & Mid(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), "=") + 1) & """ "
       ElseIf Instr(WScript.Arguments(iCount),":") > 0 Then
        strCMD = strCMD & " " & Left(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), ":") ) & """" & Mid(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), ":") + 1) & """ "
       Else
        strCMD = strCMD & " """ & Wscript.Arguments(iCount) & """ "
       End If
      Else
       strCMD = strCMD & " """ & Wscript.Arguments(iCount) & """ "
      End If
     End If
    Next
   End If
   r32wShell.Run strCMD & " " & extraargs, 0, False
   End Function

   Dim r32wShell, r32env1, r32env2, r32iCount
   Dim r32fso
   SET r32fso = CreateObject("Scripting.FileSystemObject")
   Set r32wShell = WScript.CreateObject("WScript.Shell")
   r32env1 = r32wShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
   If r32env1 <> "x86" Then ' not running in x86 mode
    For r32iCount = 0 To WScript.Arguments.Count - 1
     r32env2 = r32env2 & WScript.Arguments(r32iCount) & VbCrLf
    Next
    If InStr(r32env2,"restart32") = 0 Then RestartWithCScript32 "restart32" Else MsgBox "Cannot find 32bit version of cscript.exe or unknown OS type " & r32env1
    Set r32wShell = Nothing
    WScript.Quit
   End If
   Set r32wShell = Nothing
   Set r32fso = Nothing
   ' *******************
   ' *** END 64bit check
   ' *******************
 
Anzeige

Neue Beiträge

Anzeige