Gleich strukturierte Excel-Dateien zusammenführen

Forumthread: Gleich strukturierte Excel-Dateien zusammenführen

21.02.2017 16:51:00

Alex

Liebe Forum-Mitglieder. Ich bin der Alex und bin neu hier im Forum. Ich versuche Euch mein Problem zu schildern und hoffe jemand von Euch kann mir einen Lösungsweg empfehlen oder mich irgendwie auf dem Weg zur Lösung unterstützen. Ich habe bereits sehr viel gegoogelt und viel gefunden. Aber irgendwie habe ich zu wenig VBA-Kenntnisse, um die gefundene Lösungsansätze an meine Bedürfnisse anzupassen. Aber zurück zum Problem:
- Ich habe viele (grösser 1000) genau gleich strukturierte Excel-Dateien in einem Verzeichnis. Die Dateinamen sind: 1.xls, 2.xls, ....., n.xls
- Diese möchte in eine separate Datei in einem einzigen Tabellenblatt einfügen und noch die Form so anpassen, dass ich danach eine Pivot-Tabelle erstellen kann.
- Bei der Übernahme der Dateien möchte ich genau sagen können welche Zelle aus der Quelldatei in welche Zelle in der Zieldatei landen soll bzw. in der Zieldatei noch einige Zellen verbinden und zentrieren
- Die Zuordnung zwischen Quelle und Ziel ist nicht immer 1:1, konkret möchte ich mit dem Inhalt einer Zelle aus der Quelldatei mehrere Zellen in der Zieldatei füllen.
Übertragstabelle:
Datei 1
- Quelle (A1) zu Ziel (A1:A41)
- Quelle (B1-B41) zu Ziel(B1-B41)
- Ziel C1 bis C41 füllen mit -60, -57, -54, -51, -48, ... 0, 3, 6, ...60 (oder falls dies schwierig ist einfach leer lassen)
- Quelle (C1-C41) zu Ziel (D1-D41)
- Quelle (D1-D41) zu Ziel(E1-E41)
- Quelle (E1) zu Ziel (F1) und Zellen F1 bis F41 verbinden
- Quelle (E2) zu Ziel (G1) und Zellen G1 bis G41 verbinden
- Quelle (E3) zu Ziel (H1) und Zellen H1 bis H41 verbinden
Datei 2
- Quelle (A1) zu Ziel (A42:A82)
- Quelle (B1-B41) zu Ziel(B42-B82)
- Ziel C42 bis C82 füllen mit -60, -57, -54, -51, -48, ... 0, 3, 6, ...60 (oder falls dies schwierig ist einfach leer lassen)
- Quelle (C1-C41) zu Ziel (D42-D82)
- Quelle (D1-D41) zu Ziel(E42-E82)
- Quelle (E1) zu Ziel (F42) und Zellen F42 bis F82 verbinden
- Quelle (E2) zu Ziel (G42) und Zellen G42 bis G82 verbinden
- Quelle (E3) zu Ziel (H42) und Zellen H42 bis H82 verbinden
usw.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Gleich strukturierte Excel-Dateien zusammenführen

21.02.2017 18:33:46

JoWE

Hallo Alex,
das Nachbauen von tausenden von Dateien hab' ich mir gespart :-)
Also habe ich versuchsweise folgenden Code zusammengebaut aber nicht testen können.
Das könnte funktionieren; vielleicht treten aber auch Fehler auf.


Option Explicit
'Die Arbeitsmappe, die diesen Code enthält benötigt eine leere Tabelle "Main"
'Die Arbeitsmappe, die diesen Code enthält benötigt eine  Tabelle "Sources"
'Die tausende Arbeitsmappen solltest Du in die Tabelle "Sources" importieren/einlesen
Sub Datensammler()
Dim myAM As Workbook
Dim mySh As Worksheet
Dim ze As Long 'Zeilenzähler
Dim i As Long ' noch ein Zeilenzähler
Dim t As Long 'variable für die "Treppe"
Dim myFile As Range 'Dateinamen in Tabelle "Sources" incl. Pfadname in Spalte A ?
Set myAM = ThisWorkbook
Set mySh = myAM.Sheets("Main")
'Zeilenzähler; Variable mit Startwert belegen, Start in Zeile 1
ze = 1
'Schleife starten. Alle Dateien aus der Tabelle "Sources" nacheinander öffnen
'und mit  nachfolgendem Code gewünschte Daten in die Tabelle "Main" hineinkopieren
For Each myFile In Sheets("Sources").Range("A1:A2500") 'mehr als 2500 Dateien? Anpassen
Workbooks.Open Filename:=myFile.Value
With Sheets("Tabelle1") ' Tabellenname anpassen sofern nicht "Tabelle1"
.Range("A1").Copy Destination:=mySh.Range("A" & ze)
.Range("B1:D41").Copy Destintaion:=mySh.Range("B" & ze)
.Range("E1:E3").Copy Destination:=mySh.Range("F" & ze)
End With
myFile.Close savechanges:=False
'In den Spalten F, G, H Zellen senkrecht verbinden
Range(Cells(ze, 6), Cells(ze + 40, 6)).Merge
Range(Cells(ze, 7), Cells(ze + 40, 7)).Merge
Range(Cells(ze, 8), Cells(ze + 40, 8)).Merge
'Die Spalte C mit der gewünschten "Treppe runter & rauf" füllen
t = -60
For i = 3 To 23
Cells(i, 3) = t
t = t + 3
Next
For i = 24 To 43
Cells(i, 3) = t
t = t + 3
Next
'Zeilenzähler um 41 erhöhen; die nächsten Daten sollen angehängt werden
ze = ze + 41
Next
End Sub

Gruß
Jochen

AW: Gleich strukturierte Excel-Dat. zusammenführen

22.02.2017 00:56:37

Alex

Hallo Jochen
Zuerst einmal herzlichen Dank für Deine Unterstützung und für die Zeit, die Du dir genommen hast. Leider hat etwas nicht ganz geklappt bzw. diverse Fehler sind aufgetreten. Mit Debuggen bin ich nicht wirklich weitergekommen, daher versuche ich mit Beispieldateien das Problem nochmals zu schildern.
Hier sind zwei (der über 1000) Quelldateien:
https://www.herber.de/bbs/user/111653.xlsx
https://www.herber.de/bbs/user/111654.xlsx
In der ersten Quelldatei habe ich die relevanten Zellen farblich markiert. Die gleiche Farben habe ich in der Zieldatei verwendet, um zu verdeutlichen welche Zellen aus der Quelldatei in welche Zellen in die Zieldatei hineinkopiert werden sollen. Hier die Zieldatei:
https://www.herber.de/bbs/user/111655.xlsx
Nun zu den Fehler, die ich beim Ausführen Deines Codes erhalten habe:
- Die Tabellen heissen leider nicht Tabelle1, sonder jeweils wie die Datei selber. Habe ich aber mit einer Variable gelöst
- .Range("A1").Copy Destination:=mySh.Range("A" & ze), Das Problem ist hier, dass ich mit dem Wert A1 aus der Quelldatei die Zellen A1 bis A41 der Zieldatei füllen möchte. Dies ergibt zwar keine Fehlermeldung, der Wert wird aber jeweils nur in die Zelle A1, A42,....usw. geschrieben.
- .Range("B1:D41").Copy Destintaion:=mySh.Range("B" & ze), hier bekomme ich einen Laufzeitfehler. Meine Vermutung ist, dass Excel(oder VBA) ein Problem damit hat, ein Bereich in eine einzelne Zelle zu kopieren.
- myFile.Close savechanges:=False, Hier meckert VBA, dass die Methode Close nicht existiert
- 'In den Spalten F, G, H Zellen senkrecht verbinden
Range(Cells(ze, 6), Cells(ze + 40, 6)).Merge
Range(Cells(ze, 7), Cells(ze + 40, 7)).Merge
Range(Cells(ze, 8), Cells(ze + 40, 8)).Merge
Damit werden zwar die Zellen verbunden, aber nicht in der Zieldatei, sondern wird in der Quelldatei etwas gemacht.
Ich hoffe Du findest Zeit um meine Antwort zu anzuschauen und hast vielleicht der eine oder andere Tipp um die Fehler zu beheben. Alle Hilfen sind auf jeden Fall willkommen und werden auch sehr geschätzt. Besten Dank.
Gruss
Alex

AW: Gleich strukturierte Excel-Dat. zusammenführen

22.02.2017 08:31:35

JoWE

Hi Alex,
die "Fehlerhäufung" hatte ich ja schon "angedroht".
Die Dateien (1.xlsx und 2.xlsx) habe ich für meine Lösung in den Ordner "C:\Daten\Alex" gespeichert.
Die entsprechenden Dateinamen und die Pfadangaben der beiden Dateien befinden sich in der angehängten Arbeitsmappe in der Tabelle "Sources". In der Tabelle "Main" führst Du das Makro "Datensammler" aus.
Bei mir klappt's
Hier die Datei: https://www.herber.de/bbs/user/111656.xlsm
Gruß
Jochen

AW: Gleich strukturierte Excel-Dat. zusammenführen

22.02.2017 12:54:42

JoWE

Hi,
hatte noch etwas nicht berücksichtigt:
Diesen Teil des Codes musst Du noch austauschen:


'Die Spalte C mit der gewünschten "Treppe runter & rauf" füllen
t = -60
For i = ze To ze + 20
.Cells(i, 3) = t
t = t + 3
Next
For i = ze + 21 To ze + 40
.Cells(i, 3) = t
t = t + 3
Next

Gruß
Jochen

AW: Gleich strukturierte Excel-Dat. zusammenführen

22.02.2017 22:22:12

Alex

Hallo Jochen,
Nochmals herzlichen Dank für Deine Unterstützung und entschuldige mich für die verspätete Antwort. Das "Problem" ist privater Natur (Auswertung von Sensormessdaten) und kann tagsüber im Geschäft nicht daran arbeiten. Daher bin ich erst heute Abend dazu gekommen Deine Lösungen auszuprobieren.
Du hast mir wirklich eine Menge Arbeit erspart und dazu habe ich noch einiges gelernt. Dafür wirklich nochmals herzlichen Dank. Ich weiss leider nicht wie ich mich revanchieren kann, mit VBA-Tipps wird es für mich schwierig sein. Aber wenn Du z.B. etwas aus der Schweiz benötigst, einfach melden...
Zurück zur Lösung, ich habe noch einige Anpassungen gemacht.
Die Spaltenübersetzung habe ich aufgetrennt, damit die Spalten C und D beide übernommen werden, ansonsten würde die Spalte C durch die "Treppe" ersetzt werden und die Spalte E wäre leer in der Zieldatei.
Deine Korrektur für die Treppe funktioniert ebenfalls super.
Hier nochmals die vollständige Lösung, evtl. kann davon sonst noch jemand profitieren:
Option Explicit
'Die Arbeitsmappe, die diesen Code enthält benötigt eine leere Tabelle "Main"
'Die Arbeitsmappe, die diesen Code enthält benötigt eine Tabelle "Sources"
'Die tausende Arbeitsmappen solltest Du in die Tabelle "Sources" importieren/einlesen


Sub Datensammler()
Dim myAM As Workbook
Dim mySh As Worksheet
Dim ze As Long 'Zeilenzähler
Dim i As Long ' noch ein Zeilenzähler
Dim t As Long 'variable für die "Treppe"
Dim myFile As Range 'Dateinamen in Tabelle "Sources" incl. Pfadname in Spalte A ?
Set myAM = ThisWorkbook
Set mySh = myAM.Sheets("Main")
Application.ScreenUpdating = False
'Alle Daten aus Tabelle "Main" löschen
mySh.Cells.Delete
'Zeilenzähler; Variable mit Startwert belegen, Start in Zeile 1
ze = 1
'Schleife starten. Alle Dateien aus der Tabelle "Sources" nacheinander öffnen
'und mit  nachfolgendem Code gewünschte Daten in die Tabelle "Main" hineinkopieren
For Each myFile In Sheets("Sources").Range("A1:A2") 'mehr als 2500 Dateien? Anpassen
Workbooks.Open Filename:=myFile.Value
With Sheets(1) ' Tabellenname anpassen sofern nicht "Tabelle1"
.Range("A1").Copy Destination:=mySh.Range("A" & ze)
.Range("B1:B41").Copy Destination:=mySh.Range("B" & ze)
.Range("C1:C41").Copy Destination:=mySh.Range("D" & ze)
.Range("D1:D41").Copy Destination:=mySh.Range("E" & ze)
.Range("E1").Copy Destination:=mySh.Range("F" & ze)
.Range("E2").Copy Destination:=mySh.Range("G" & ze)
.Range("E3").Copy Destination:=mySh.Range("H" & ze)
mySh.Range("A" & ze).Copy
mySh.Range("A" & ze + 1 & ":A" & ze + 40).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
ActiveWorkbook.Close savechanges:=False
With mySh
'In den Spalten F, G, H Zellen senkrecht verbinden
.Range(Cells(ze, 6), Cells(ze + 40, 6)).Merge
.Cells(ze, 6).HorizontalAlignment = xlCenter
.Cells(ze, 6).VerticalAlignment = xlCenter
.Cells(ze, 7).HorizontalAlignment = xlCenter
.Cells(ze, 7).VerticalAlignment = xlCenter
.Cells(ze, 8).HorizontalAlignment = xlCenter
.Cells(ze, 8).VerticalAlignment = xlCenter
.Range(Cells(ze, 7), Cells(ze + 40, 7)).Merge
.Range(Cells(ze, 8), Cells(ze + 40, 8)).Merge
'Die Spalte C mit der gewünschten "Treppe runter & rauf" füllen
t = -60
For i = ze To ze + 20
.Cells(i, 3) = t
t = t + 3
Next
For i = ze + 21 To ze + 40
.Cells(i, 3) = t
t = t + 3
Next
'Zeilenzähler um 41 erhöhen; die nächsten Daten sollen angehängt werden
ze = ze + 41
End With
Next
With Columns("A:A")
.Replace What:=".000000", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.HorizontalAlignment = xlCenter
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Viele Grüsse aus der Schweiz
Alex

AW: Gerne, danke für die Rückmeldung

23.02.2017 06:58:31

JoWE

Beliebteste Forumthreads (12 Monate)

Gleich strukturierte Excel-Dateien zusammenführen

Forumthread: Gleich strukturierte Excel-Dateien zusammenführen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread