Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
964to968
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
964to968
964to968
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Textdateien zusammenführen

Textdateien zusammenführen
03.04.2008 09:34:42
Daniel
Hallo!
Ich habe einen Bestand an Textdateien. Diese befinden sich in drei Ordnern. Die genauen Pfade der Dateien habe ich in drei Blättern eingefügt. Die Pfade stehen in A und das Datum der Datei im Format JJJJMMTT in B.
Nun gibt es für verschiedene Datums eine Datei mit einer Liste.
Für jedes Datum, dass in allen drei Blättern vorhanden ist, sollen die drei Textdateien in eine neue Datei zusammengefasst werden in einen neuen Ordner.
Kann mir jemand eine Starthilfe geben, wie ich da in VBA vorgehen soll?

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textdateien zusammenführen
03.04.2008 09:47:38
Tino
Hallo,
hast du eine Muster Textdatei?
Gruß
Tino

AW: Textdateien zusammenführen
03.04.2008 09:56:00
Daniel
Die Textdateien sind ganz einfach, es sind Listen von bestimmten Aktien:
ADS GY
ALV GY
BAS GY
BAY GY
BMW GY
CBK GY
DAI GY
DBK GY
DGX GY
DPW GY
DTE GY
.....

AW: Textdateien zusammenführen
03.04.2008 10:14:00
Tino
Hallo,
versuche es mal hiermit, habe es nicht getestet.

Option Explicit
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function
Sub TestLese()
Dim NeueTXT As String, Pfad As String, sFilename As String
Dim F As Integer
'Datei 1
Pfad = Sheets("Tabelle1").Range("A1") & "\" & _
Format(Sheets("Tabelle1").Range("B1"), "yyyymmdd")
NeueTXT = txt_ReadAll(Pfad)
'Datei 2
Pfad = Sheets("Tabelle2").Range("A1") & "\" & _
Format(Sheets("Tabelle2").Range("B1"), "yyyymmdd")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
'Datei 3
Pfad = Sheets("Tabelle3").Range("A1") & "\" & _
Format(Sheets("Tabelle3").Range("B1"), "yyyymmdd")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
ChDir ThisWorkbook.Path
'SpeicherPfad Neu
sFilename = Application.GetSaveAsFilename("test", "Textdateien (*.txt), *.txt")
If sFilename = "Falsch" Then Exit Sub
If LCase(Right(sFilename, 4))  ".txt" Then sFilename = sFilename & ".txt"
F = FreeFile
Open sFilename For Output As #F
Print #F, NeueTXT
Close #F
End Sub


Gruß
Tino

Anzeige
AW: Textdateien zusammenführen
03.04.2008 10:35:37
Daniel
Das zuammenführen in die Textdatei klappt gut.
Allerdings hatte ich mich wohl falsch ausgedrückt, was den Pfad und die Dateinamen angeht.
Die Texte in den Spalten A der Blätter sind bereits der komplette Dateipfad.
Es ist nur so, dass nicht jede Zeile in der einen Tabelle mit der gleichen Zeile der anderen Tabelle übereinstimmt. Ich habe mir hier nun folgende Vorgehensweise vorgestellt:
In Spalte B steht das jeweilig Datum der Dateien. Wenn nun ein Datum der einen Tabelle nicht mit dem Dateum der anderen übereinstimmt, dann soll diese Datum einfach ignoriert werden, und mit dem nächsten Datum weitergemacht werden.
Also

  • Datei1 Datei2 Datei3
    20020502 20020502 20020503

    • In Datei3 fehlt das Datum der beiden anderen, daher soll das ignoriert werden.
    Dadurch verschieben sich aber leider die Zeilen.
    Vielleicht ist es einfach besser von Datei1 auszugehen und dann in den anderen beiden Blättern nach diesem Dateum zu suchen, und die Dateien dieser Zeilen zusammenzuführen.
    Die neue Datei soll dann in den Pfad ink. Dateinamen in Tabelle "Bestandsliste" H1 & jeweiliges Datum erstellt werden.
    Kannst du mir da noch helfen?
    Hier noch der aktuelle Code:
    Option Explicit
    
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function


    Sub TestLese()
    Dim NeueTXT As String, Pfad As String, sFilename As String
    Dim F As Integer
    'Datei 1
    Pfad = Sheets("DAX").Range("A1")
    NeueTXT = txt_ReadAll(Pfad)
    'Datei 2
    Pfad = Sheets("AEX").Range("A1")
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    'Datei 3
    Pfad = Sheets("CAC").Range("A1")
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    ChDir ThisWorkbook.Path
    'SpeicherPfad Neu
    sFilename = Application.GetSaveAsFilename("test", "Textdateien (*.txt), *.txt")
    If sFilename = "Falsch" Then Exit Sub
    If LCase(Right(sFilename, 4)) ".txt" Then sFilename = sFilename & ".txt"
    F = FreeFile
    Open sFilename For Output As #F
    Print #F, NeueTXT
    Close #F
    End Sub


    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 11:10:09
    Tino
    Hallo,
    wen ich dich jetzt richtig verstanden habe müsste es so gehen.
    
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function
Sub TestLese()
Dim NeueTXT As String, Pfad As String, sFilename As String
Dim F As Integer, SuchDatum As Date
With Sheets("DAX")
'Datei 1
Pfad = .Range("A1")
NeueTXT = txt_ReadAll(Pfad)
SuchDatum = CDate(.Range("B1")) 'zu suchendes Datum
End With
With Sheets("AEX")
'Datei 2
If CDate(.Range("B1")) = SuchDatum Then
Pfad = Sheets("AEX").Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
End If
End With
With Sheets("CAC")
'Datei 3
If CDate(.Range("B1")) = SuchDatum Then
Pfad = .Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
End If
End With
ChDir ThisWorkbook.Path
'SpeicherPfad Neu
sFilename = Application.GetSaveAsFilename("test", "Textdateien (*.txt), *.txt")
If sFilename = "Falsch" Then Exit Sub
If LCase(Right(sFilename, 4))  ".txt" Then sFilename = sFilename & ".txt"
F = FreeFile
Open sFilename For Output As #F
Print #F, NeueTXT
Close #F
End Sub


    Gruß
    Tino

    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 11:14:00
    Daniel
    Erstmal danke:
    Leider kommt die Fehlermeldung Typen unverträglich:
    SuchDatum = CDate(.Range("B1")) 'zu suchendes Datum

    AW: Textdateien zusammenführen
    03.04.2008 11:22:00
    Tino
    Hallo,
    was genau steht in diesen Zellen, ein Datum (Formatiert in TTMMJJJJ) davon bin ich ausgegangen
    oder steht nur ein Text in der oder den Zellen?
    Ist es nur Text versuche es so.
    
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function
Sub TestLese()
Dim NeueTXT As String, Pfad As String, sFilename As String
Dim F As Integer, SuchDatum As String
With Sheets("DAX")
'Datei 1
Pfad = .Range("A1")
NeueTXT = txt_ReadAll(Pfad)
SuchDatum = .Range("B1") 'zu suchendes Datum
End With
With Sheets("AEX")
'Datei 2
If .Range("B1") = SuchDatum Then
Pfad = Sheets("AEX").Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
End If
End With
With Sheets("CAC")
'Datei 3
If .Range("B1") = SuchDatum Then
Pfad = .Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
End If
End With
ChDir ThisWorkbook.Path
'SpeicherPfad Neu
sFilename = Application.GetSaveAsFilename("test", "Textdateien (*.txt), *.txt")
If sFilename = "Falsch" Then Exit Sub
If LCase(Right(sFilename, 4))  ".txt" Then sFilename = sFilename & ".txt"
F = FreeFile
Open sFilename For Output As #F
Print #F, NeueTXT
Close #F
End Sub


    Gruß
    Tino

    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 11:32:09
    Daniel
    Hallo Tino,
    ja es sind Texte. Nun kommt keine Fehlermeldung.
    Zwei Dinge, die sofort auffallen:
    a) Die gespeicherte Datei soll in den Pfad, der in der Tabelle "Bestandsliste", Range("H2") steht und soll das Datum als Dateiname bekommen.
    b) Obwohl das Datum der Datei1 in einem der beiden Datei2 oder Datei3 nicht vorkommt, wird die Datei erstellt. Sie soll jedoch nur erstellt werden, wenn dieses Datum wirklich in allen drei vorkommt.
    Leider verstehe ich den Code zu wenig, um das selbst ändern zu können.
    Danke für Deine Hilfe!

    AW: Textdateien zusammenführen
    03.04.2008 11:57:00
    Tino
    Hallo,
    jetzt müsste es aber passen.
    
Option Explicit
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function
Sub TestLese()
Dim NeueTXT As String, Pfad As String, sFilename As String
Dim F As Integer, SuchDatum As String
With Sheets("DAX")
'Datei 1
Pfad = .Range("A1")
NeueTXT = txt_ReadAll(Pfad)
SuchDatum = .Range("B1") 'zu suchendes Datum
End With
With Sheets("AEX")
'Datei 2
If .Range("B1") = SuchDatum Then
Pfad = Sheets("AEX").Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
Else
MsgBox "Datei wurde nicht erstellet", vbCritical
Exit Sub
End If
End With
With Sheets("CAC")
'Datei 3
If .Range("B1") = SuchDatum Then
Pfad = .Range("A1")
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
Else
MsgBox "Datei wurde nicht erstellet", vbCritical
Exit Sub
End If
End With
'SpeicherPfad Neu
sFilename = Sheets("Bestandsliste").Range("H2")
If LCase(Right(sFilename, 1))  "\" Then sFilename = sFilename & "\"
sFilename = sFilename & Format(Date, "dd_mm_yyyy") & ".txt"
F = FreeFile
Open sFilename For Output As #F
Print #F, NeueTXT
Close #F
End Sub


    Gruß
    Tino

    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 12:17:00
    Daniel
    Ja, es passt nun. Ich habe nur noch den Dateinamen der neuen Datei abgeändert.
    Nun brauche ich noch eine Schleife. Die will ich aber mal selbst hinkriegen.
    Dazu wäre aber noch nötig, die Fehlermeldung wegzulassen und mit der Prozedur trotzdem weiterzumachen. Was muss ich dazu noch ändern?
    Option Explicit
    
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function


    Sub TestLese()
    Dim NeueTXT As String, Pfad As String, sFilename As String
    Dim F As Integer, SuchDatum As String
    With Sheets("DAX")
    'Datei 1
    Pfad = .Range("A1")
    NeueTXT = txt_ReadAll(Pfad)
    SuchDatum = .Range("B1") 'zu suchendes Datum
    End With
    With Sheets("AEX")
    'Datei 2
    If .Range("B1") = SuchDatum Then
    Pfad = Sheets("AEX").Range("A1")
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    Else
    MsgBox "Datei wurde nicht erstellet", vbCritical
    Exit Sub
    End If
    End With
    With Sheets("CAC")
    'Datei 3
    If .Range("B1") = SuchDatum Then
    Pfad = .Range("A1")
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    Else
    MsgBox "Datei wurde nicht erstellet", vbCritical
    Exit Sub
    End If
    End With
    'SpeicherPfad Neu
    sFilename = Sheets("Bestandsliste").Range("H1")
    sFilename = sFilename & SuchDatum & ".txt"
    F = FreeFile
    Open sFilename For Output As #F
    Print #F, NeueTXT
    Close #F
    End Sub


    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 12:32:46
    Tino
    Hallo,
    möchtest du dies in einer Schleife verwenden, musst du einiges anpassen.
    1. mach die MsgBoxen raus
    2. bei jeden Schleifendurchlauf musst du NeueTXT leeren (NeueTXT = "")
    3. anstatt Exit Sub mach eine Sprungmarke zum ende der Schleife (Goto Nächste: oder so)
    4. die Zellen mit dem Pfad und dem Datum müssen entsprechend angesprochen werden
    Viel Spaß beim basteln, muss jetzt leider auch auf die Mittagschicht
    Gruß
    Tino

    AW: Textdateien zusammenführen
    03.04.2008 14:48:00
    Daniel
    Okay, ich bin schon weiter gekommen denke ich.
    Allerdings ist da noch etwas unpassend. Und zwar soll das Datum nicht in den gleichen Zeilen gesucht werden, sondern irgendwo in Spalte B. Wie geht das nun?
    Hier der aktuelle Code:
    Option Explicit
    
Public Function txt_ReadAll(ByVal sFilename As String) _
As String
Dim F As Integer
Dim sInhalt As String
' Existiert die Datei ?
If Dir$(sFilename, vbNormal)  "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
txt_ReadAll = sInhalt
End Function


    Sub TestLese()
    Dim NeueTXT As String, Pfad As String, sFilename As String
    Dim F As Integer, SuchDatum As String
    Dim i As Integer
    For i = 1 To 5 'Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DAX")
    'Datei 1
    Pfad = .Range("A" & i)
    NeueTXT = txt_ReadAll(Pfad)
    SuchDatum = .Range("B" & i) 'zu suchendes Datum
    End With
    With Sheets("AEX")
    'Datei 2
    If .Range("B" & i) = SuchDatum Then
    Pfad = Sheets("AEX").Range("A" & i)
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    Else
    GoTo Nächstes
    End If
    End With
    With Sheets("CAC")
    'Datei 3
    If .Range("B" & i) = SuchDatum Then
    Pfad = .Range("A" & i)
    NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
    Else
    GoTo Nächstes
    End If
    End With
    'SpeicherPfad Neu
    sFilename = Sheets("Bestandsliste").Range("H1")
    sFilename = sFilename & SuchDatum & ".txt"
    F = FreeFile
    Open sFilename For Output As #F
    Print #F, NeueTXT
    Close #F
    Nächstes:
    Next i 'Hauptschleife, die durch alle Dateien läuft
    End Sub


    Anzeige
    AW: Textdateien zusammenführen
    03.04.2008 23:05:00
    Tino
    Hallo,
    habe es aber nicht getestet, die Funktion bleibt unverändert.
    
Sub TestLese()
Dim NeueTXT As String, Pfad As String, sFilename As String
Dim F As Integer, SuchDatum As String, SuZell As Range
Dim i As Integer
For i = 1 To 5 'Cells(Rows.Count, 1).End(xlUp).Row
NeueTXT = ""
With Sheets("DAX")
'Datei 1
Pfad = .Range("A" & i)
NeueTXT = txt_ReadAll(Pfad)
SuchDatum = .Range("B" & i) 'zu suchendes Datum
End With
With Sheets("AEX")
'Datei 2
'Suche Datum in B:B
Set SuZell = .Range("B:B").Find(What:=SuchDatum, LookIn:=xlValues, _
LookAt:=xlWhole)
If Not SuZell Is Nothing Then 'prüfe ob Datum gefunden
Pfad = SuZell.Offset(0, -1) 'Wert aus Zelle links davon
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
Else
GoTo Nächstes
End If
End With
With Sheets("CAC")
'Datei 3
'Suche Datum
Set SuZell = .Range("B:B").Find(What:=SuchDatum, LookIn:=xlValues, _
LookAt:=xlWhole)
If Not SuZell Is Nothing Then
Pfad = SuZell.Offset(0, -1)
NeueTXT = NeueTXT & vbCrLf & txt_ReadAll(Pfad)
Else
GoTo Nächstes
End If
End With
'SpeicherPfad Neu
sFilename = Sheets("Bestandsliste").Range("H1")
sFilename = sFilename & SuchDatum & ".txt"
F = FreeFile
Open sFilename For Output As #F
Print #F, NeueTXT
Close #F
Nächstes:
Set SuZell = Nothing
Next i 'Hauptschleife, die durch alle Dateien läuft
End Sub


    Gruß
    Tino

    Anzeige
    Danke! ;-)) o.T.
    04.04.2008 15:49:41
    Daniel
    ..

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige