Microsoft Excel

Herbers Excel/VBA-Archiv

Daten zusammenführen

Betrifft: Daten zusammenführen von: Uwe
Geschrieben am: 03.09.2014 21:56:50

Habe folgende Aufgabenstellung:
Ich muss Daten aus verschiedenen Excel-Dateien, welche sich alle im gleichen Ordner befinden, in einer übergeordneten Datei zusammenführen.

Die übergeordnete Datei ist die Jahrestabelle (Jahr2114.xls)
Die Datenquellen sind Monatstabellen. Jan2014.xls, Feb2014.xls usw.
Die Monatstabellen sind immer gleich aufgebaut.
In Jan2014.xls gibt es die Tabellenblätter: JanGes, 1.1, 1.2, 1.3, ………………1.14
In Feb2014.xls gibt es die Tabellenblätter: FebGes, 2.1, 2,2, 2,3, ………2,8
usw.
Im Tabellenblatt xxxGes werden Informationen aus den Tabellenblättern
x.1 x.2 bis x.n gesammelt.
Für jedes der Tabellenblätter x.1 bis x.n gibt es in xxxGes eine Zeile
Dh. in xxGes sind ab Zeile 5 in Spalte B bis Spalte H die Informationen aus den nachfolgenden Tabellenblättern
Die Anzahl der Zeilen ist unterschiedlich weil die Anzahl der Tabellenblätter unterschiedlich ist.
Somit sind die Informationen in JanGes in den Zeilen 5 bis 19 und
in FebGes in den Zeilen 5 bis 13.
(JanGes, FebGes, MarGes, usw sind in unterschiedlichen Tabellen)
In der jeweils letzten Zeile werden die Zahlen aus den Spalten summiert.
Bis hierhin ist alles mit SVERWEIS , INDIREKT etc. gelöst

Jetzt mein Problem:
Wie bereits beschrieben sollen die Werte aus xxGes in der Jahrestabelle zusammengeführt werden.
Wäre die Anzahl der Zeilen in den Monatstabellen gleich, und würden alle Monatstabellen existieren könnte man wieder über SVERWEIS das Tabellenblatt 2014Ges in der Jahrestabelle beschreiben.
Aber im Tabellenblatt 2014Ges sollen ab Zeile 5 Spalte B bis H (gleicher Aufbau wie in den Monatstabellen) die Daten fortlaufend in den Zeilen eingetragen werden.
Für Januar Zeile 5 bis 19
Für Februar Zeile 20 bis 28
usw. bis Zeile xxx
In der Letzten Zeile (xxx+1) soll dann wieder in den Spalten B bis H summiert werden.

Die Struktur der Tabellenblätter einschl Summierung in der letzten Zeile ist immer gleich.

Ich habe aktuell keinen Ansatz dafür, wie ein Makro aussehen muss, das Zeilen aus verschiedenen Tabellen importiert und einfügt, wobei die Anzahl der Zeilen unbekannt ist.
Das gesamte Tabellenblatt zu exportieren scheint mir auch nicht sinnvoll zu sein.

Evtl. kann mir ja jemand eine Hilfestellung geben.
Vielen Dank im voraus

Uwe

  

Betrifft: AW: Daten zusammenführen von: Marco Rinne
Geschrieben am: 03.09.2014 23:40:11

Hallo Uwe,

einen konkreten Lösungsvorschlag habe ich nicht ohne die Datei gesehen zu haben, aber einen Ansatz der dich vielleicht auf einen passenden Weg bringt. Da meine erste Antwort verschwunden ist - habe ausversehen auf zurück geklickt... - hier nochmal in Stichpunkten:

1. ermittle das Ende der jeweiligen Liste. Dafür gibt es einige Möglichkeiten, mein Favorit ist mit =ANZAHL2 zu arbeiten.
2. ab jetzt weiter mit VBA: einer Variable den eben bestimmten Wert zuweisen und 5 addieren, damit man immer dynamisch das Listenende hat.
3. jetzt kannst du ja den entsprechenden Bereich, also B bis H jeweils bis zum Ende kopieren und in die Aggregationstabelle (Jahr2014) einfügen. Da hier immer alles ans Ende gehängt werden soll, wieder die letzte beschriebene Zeile ermitteln und eine tiefer einfügen.
4. man kann ja auch ganz leicht die Summe unter den Spalten B bis H bilden, indem man eben mit dem dynamischen Tabellenende arbeitet. Wenn sich die Liste erweitert, müssen die Summen nur erst wieder rausgelöscht werden.

Das wäre grob meine Idee, vielleicht hilfts dir weiter.

Viele Grüße


  

Betrifft: AW: Daten zusammenführen von: Uwe
Geschrieben am: 04.09.2014 00:18:40

könnte man nicht ein Makro in der Jahresdatei plazieren, welches die Zeilen der Monatsdateien ab Zeile 5 bis unten einzeln kopier, und diese Zeilen in der Jahrestabelle unten anhängen?


  

Betrifft: AW: Daten zusammenführen von: Marco
Geschrieben am: 04.09.2014 11:06:15

Das Makro soll jede Zeile einzeln kopieren? Warum?
Es ist doch viel einfacher, wenn gleich der gesamte Bereich (also z.b B5:H18) kopiert und ans Ende der Jahresdatei eingefügt wird.

Viele Grüße


  

Betrifft: AW: Daten zusammenführen von: Uwe
Geschrieben am: 04.09.2014 18:29:47

Hallo Marco,
habe mir aus anderen Beiträgen einiges zusammengesucht, kriege aber die Syntax für den Bereich nicht hin.

Sub Aktualisieren()
'Datei öffnen
Workbooks.Open (ThisWorkbook.Path & "\" & "QUELLE.xls")
'Prüfen, ob bereits vorhanden
If WorksheetFunction.CountIf(Workbooks("ZIEL.xls").Sheets("Tabelle1").Range("H:H"), Range("H4"). _
Value) = 0 Then
    'Kopieren
    Range("A4:H10").Copy
    'Werte in Gesamtdatei einfügen
    Workbooks("ZIEL.xls").Sheets("Tabelle1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0). _
PasteSpecial Paste:=xlPasteValues
End If
'Fenster schließen
Workbooks("QUELLE.xls").Close
End Sub
oder
Sub Import()
Dim strImportdatei As String
Dim lngI As Long

lngI = 2

' Schleife von A2 bis in Spalte A nichts mehr drin steht.
Do While ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 1) <> ""
    strImportdatei = ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 1)
    ' Prüfen ob Datei vorhanden
    'If Dir(strImportdatei) <> "" Then
    If Dir(strImportdatei) = "" Then
        Application.DisplayAlerts = False
        ' Datei öffnen
                 Workbooks.Open (ThisWorkbook.Path & "\" & strImportdatei)

        ' Nun die Daten auslesen.
        ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 2) = ActiveWorkbook.Worksheets(1).Cells( _
 _
1, 3)
                
        ' Datei wieder schließen.
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
   Else
        ' Datei nicht vorhanden, dann halt
        ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 2) = "Fehler: Datei existiert nicht"
   End If
    lngI = lngI + 1
Loop
End Sub
oder
Sub Kopieren()
Dim wsQuelle, wsZiel As Worksheet
Dim lngLastQ As Long, lngLastZ As Long

Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1")  ' hier muß der Tabellenname rein  
Set wsZiel = ThisWorkbook.Worksheets("Tabelle2")

lngLastQ = wsQuelle.Cells(Rows.Count, 1).End(xlUp).Row 'letzte gefüllte in "A" von Quelle
lngLastZ = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row   'letzte gefüllte in "A" von Ziel
If lngLastQ > 2 Then
    wsQuelle.Range("A3:S" & lngLastQ).Copy wsZiel.Range("A" & lngLastZ + 1)
End If
End Sub

Ich meine das Makro Kopieren kommt meinen Anforderungen am nächsten.
Ich weiß aber nicht die Syntax um wsQuelle auf eine andere Datei im gleichen Ordner zu ändern.
ThisWorkbook.Path ?? aber wenn ein" oder ein . an der falschen Stelle steht kann ich nicht erkenne wo der Fehler steckt.

Wäre sehr nett, wenn Du mir das Makro Kopieren anpassen könntest.
vielen Dank

mit freundlichen Grüßen
Uwe


  

Betrifft: AW: Daten zusammenführen von: Marco Rinne
Geschrieben am: 04.09.2014 20:17:01

Hallo Uwe,

in Ansätzen hat das Makro Kopieren gepasst.
Ich habe es so abgeändert, dass es für dich funktionieren müsste. Es geht sicherlich eleganter, bspw. dass die Dateien alle nacheinander eingelesen werden und man den Knopf nicht für jeden Monat neu drücken muss... Da ich aber nicht weiß inwiefern man deine Tabelle verändern darf, habe ich es mal gelassen. Wenn man bspw. noch eine Hilftstabelle hinzufügen kann, dann kann man dort die Dateinamen (also Jan2014 - Dez2014) eintragen und das Makro mittels einer Schleife alle Dateien nacheinander einlesen lassen.

So siehts aus, schau mal ob es funktioniert (wenn dus in den VBA Editor kopierst kann man es besser lesen...):

Option Explicit

Sub Kopieren()

Dim strPfad, strDateiname, strPfadUndDatei As String
Dim lngLastQ, lngLastZ As Long

    strPfad = "C:\XXXXX\XXXXX\XXXXX\XXXXX\"                 'Pfad des Ordners, in dem die  _
einzulesenden Dateien liegen
    strDateiname = Range("A1").Value                        'in Zelle A1 des Blattes, von wo  _
aus der Code ausgeführt wird, muss der Name der_
                                                            ' einzulesenden Datei stehen. Also  _
bspw. Jan2014
    strPfadUndDatei = strPfad & strDateiname & ".xls"       'für ".xls" muss der Dateityp der  _
einzulesenden Dateien eingesetzt werden
    
'Öffnet die Quelldatei
Workbooks.Open Filename:=strPfadUndDatei

lngLastQ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _
 der Quelldatei
Range("B5:H" & lngLastQ).Select
Selection.Copy
Windows("Jahr2014").Activate                                'Wechselt wieder in die  _
Jahrestabelle, wo alle Datein eingefügt werden sollen

lngLastZ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _
 der Zieldatei
Range("B" & lngLastZ + 1).Paste

'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei
Windows(Dateiname & ".xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close
Windows("Jahr2014").Worksheets(1).Range("A1").Select

End Sub
Viele Grüße


  

Betrifft: AW: Daten zusammenführen von: Uwe
Geschrieben am: 06.09.2014 11:58:35

Hallo Marco,
Deine Änderungen haben mich ein ganzes Stück weiter gebracht.
Habe es für angepasst, funktioniert auch, habe aber einen Fehler bei der Aufgabenstellung gemacht.

In den letzten Zeilen der Jahrestabelle werden die Daten in den darüber liegenden Zeilen berechnet.
Somit müssen die mit diesm Makro eingelesenen Daten in neue / darüber liegenden Zeilen eingelesenen werden.
Es muss also die Anzahl der neuen Zeilen berechnet und erzeugt werden, und dann in diese Zeilen der
einzulesende Datenblock eingelesen werden.

Wäre super, wenn du mir hierfür nocheinmal Hilfestellung geben könntest.

Hier mein aktuelles Makro

Sub Kopieren()

Dim strPfad, strDateinameQuelle, strDateinameZiel, strPfadUndDatei As String
Dim lngLastQ, lngLastZ As Long

'Pfad des Ordners, in dem die einzulesenden Dateien liegen
      strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch))
    
'in Zelle A1 des Blattes, von wo aus der Code ausgeführt wird, muss der Name der einzulesenden  _
Datei stehen. _
Also bspw. Jan2014
    strDateinameQuelle = Range("A1").Value
    strPfadUndDatei = strPfad & strDateinameQuelle & ".xls"
    'strDateinameZiel = ActiveWorkbook.Name
    
'Öffnet die Quelldatei
Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls")
lngLastQ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _
 _
 der Quelldatei
Range("B5:H" & lngLastQ).Select
Selection.Copy
Windows(ThisWorkbook.Name).Activate
'Windows("Jahr2014.xls").Activate
'Wechselt wieder in die Jahrestabelle, wo alle Datein eingefügt werden sollen
lngLastZ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _
 _
 der Zieldatei
Range("B" & lngLastZ + 0).Select
ActiveSheet.Paste
'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei
Windows(strDateinameQuelle & ".xls").Activate
ActiveWorkbook.Close
Windows(ThisWorkbook.Name).Activate
ActiveSheet.Range("A1").Select
End Sub
Weiterhin kommen beim schließen der Quelldatei folgende Abfragen,
- Sollen Änderungen in 'Aug2014.xls' gespeichert werden
- Es befinden sich große Mengen in der Zwischenablage....

Kann man diese Meldungen unterdrücken?

viele Grüße
Uwe


  

Betrifft: AW: Daten zusammenführen von: Uwe
Geschrieben am: 07.09.2014 09:11:29

Hallo Marco,
habe lange getüftelt, aber jetzt ist das Makro fertig.
Danke für deine Vorarbeit.

Sub Import_von_Monats_Aufmass()
'----------------------------------------------------------------------------------------
'dieses Makro importiert Daten aus der Monatsdatei z.B. Aug2014 aus Tabellenblatt Aufmass _
in die Arbeitsmappe Gesamt dieser Datei.
'Der Quellbereich befindet sich im Arbeitsblatt Aufmass ab Zeile 6 zwischen den Spalten B und  _
AB
'In Zelle A1 von Gesamt muss der Name der Quellmappe eingetragen werden (Aug2014)
'Die eingelesenen Daten werden 2 Zeilen oberhalb der letzten belegten Zeile angefügt.
'--------------------------- 06.09.2014    Uwe  -------------------------------------

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim strPfad, strDateinameQuelle, strPfadUndDatei As String
Dim lngLastQ, lngLastZ, Offset As Long
Dim EZ As Integer  ' Nummer der ersten Zeile der Quelldatei
Dim LZ As Integer  ' Nummer der letzten Zeile der Quelldatei
Dim s As String  ' Adresse des markierten Bereichs der Quelldatei
Dim Länge As Integer 'Anzahl der zu kopierdenden Zeilen

'Pfad des Ordners, in dem die einzulesenden Dateien liegen
strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch))
    
'in Zelle A1 des Blattes, von wo aus der Code ausgeführt wird, muss der Name der einzulesenden  _
Datei stehen. _
Also bspw. Aug2014

strDateinameQuelle = Range("A1").Value
strPfadUndDatei = strPfad & strDateinameQuelle & ".xls"
       
'Quelldatei öffnen und Anzahl der einzulesenden zeilen errechnen
Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls")
lngLastQ = Worksheets("Aufmass").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" _
 der Quelldatei
Range("B6:AB" & lngLastQ - 1).Select ' die letzten zwei Zeilen werden nicht kopiert

'Adressen der Quelldatei auslesen
s = Selection.Address
EZ = Range(s).Row ' erste selektierte Zeile in der Quelldatei
LZ = Range(s).Row + Range(s).Rows.Count - 1 'letzte selektierte Zeile in der Quelldatei
Länge = LZ - EZ    ' Rechenwert in integer
Offset = CLng(Länge) 'Anzahl der einzulesenden Zeilen als long

' Zieldatei öffnen und Leerzeilen einfügen
Windows(ThisWorkbook.Name).Activate
lngLastZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" der Zieldatei

Dim LZZ As Integer   'Letzte zeile der Zieldatei
Dim EZZ As Integer   'erste Zeile der Zieldatei in der eingelesen werden soll

EZZ = lngLastZ + 1  ' ab dieser Zeile der Zieldatei soll der Datenblock eingefügt werden
LZZ = EZZ + Offset + 1 ' Bis zu dieser Zeile sollen entsprechen der Länge des Datenblocks neue  _
Zeilen eingefügt werden

'------- Leerzeilen einfügen in der Zieldatei einfügen ---------------------

Dim y As Integer    ' Schleifenzähler für einzufügende Leerzeilen
With ThisWorkbook.Worksheets("Gesamt")
For y = EZZ To LZZ
.Cells(y, 1).Select
Selection.EntireRow.Insert
Next y
End With

'------  aus Quelldatei Datenblock holen --------------
'Öffnet die Quelldatei
Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls")
lngLastQ = Worksheets("Aufmass").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" _
 der Quelldatei
Range("B6:AB" & lngLastQ + 0).Select ' die letzten zwei Zeilen werden nicht kopiert
Selection.Copy
Windows(ThisWorkbook.Name).Activate
'Wechselt wieder in die Zieltabelle, wo alle Datein eingefügt werden sollen
lngLastZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" der Zieldatei
Range("B" & EZZ + 0).PasteSpecial Paste:=xlValues 'Werte kopieren
Range("B" & EZZ + 0).PasteSpecial Paste:=xlFormats 'Formate kopieren
'Range("B" & lngLastZ + 1).Select   'alles
'ActiveSheet.Paste                  'einschl Formeln kopieren
Application.CutCopyMode = False
'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei
Windows(strDateinameQuelle & ".xls").Activate
'Application.DisplayAlerts = False
ActiveWorkbook.Close
Windows(ThisWorkbook.Name).Activate
     ActiveSheet.Range("A1").Select
     ActiveWorkbook.Save
     Application.DisplayAlerts = True
     Application.EnableEvents = True
End Sub

mit freundlichen Grüßen
Uwe


  

Betrifft: AW: Daten zusammenführen von: Marco
Geschrieben am: 07.09.2014 11:06:27

Moin Uwe,

freut mich dass es jetzt funktioniert. Ich schau mir nachher mal aus Interesse an wie dus gemacht hast ;)

Viele Grüße


 

Beiträge aus den Excel-Beispielen zum Thema "Daten zusammenführen"