Makro zum Zusammenfassen mehrerer Dateien
Betrifft: Makro zum Zusammenfassen mehrerer Dateien
von: Florian
Geschrieben am: 15.11.2014 18:59:10
Hallo Spezialisten,
hab mit eurer Hilfe einen Code zusammengebastelt welcher mir von allen Excel-Dateien eines Ordners welche unter dem Namen Plan *.xlsm abgespeichert wurden den Bereich Q4:Q20 aufsummiert. Soweit klappt das auch wunderbar und ist mir eine sehr sehr große Hilfe! Nun bräuchte ich allerdings nicht die Aufsummierung der Bereiche sondern einfach nur die Inhalte welche sich in dem oben besagten Bereich enthalten. Die Inhalte in den Bereichen sind als Text formatiert.
Ich wäre äußerst dankbar für jede Hilfe!
Hier der Link zum File: https://www.herber.de/bbs/user/92780.xlsm
Schöne Grüße
Florian
Betrifft: AW: Makro zum Zusammenfassen mehrerer Dateien
von: Christian
Geschrieben am: 16.11.2014 10:24:11
hallo Florian,
ich geh mal davon aus, dass die Inhalte von mehreren Dateien dann untereinander geschrieben werden sollen. Hier ein Bsp auf Basis deines Makros. Die Fehlerbehandung musst du ggf. noch einsetzen.
Sub DatenAddierenNEU(BlattName As String, Bereich As Range)
Dim rngDest As Range
Dim sFormel As String, iPos As Integer
Dim lstrPath As String, lstrFile As String
lstrPath = Range("A1") ' Pfad anpassen!!!
lstrFile = Dir(lstrPath & "Plan*.xlsm")
If lstrFile = "" Then
MsgBox "Im Verzeichnis keine Plan*-Dateien vorhanden"
Exit Sub
End If
Set rngDest = Bereich
Do Until lstrFile = ""
iPos = InStrRev(lstrPath & lstrFile, Application.PathSeparator)
sFormel = "='" & Left(lstrPath & lstrFile, iPos) _
& "[" & Mid(lstrPath & lstrFile, iPos + 1) & "]" _
& BlattName & "'!" & Bereich.Address(ReferenceStyle:=xlR1C1)
' Forrmel eintragen
rngDest.FormulaArray = sFormel
' in Werte wandeln
rngDest.Value = rngDest.Value
' Zielbereich versetzen
Set rngDest = rngDest.Offset(Bereich.Rows.Count)
lstrFile = Dir
Loop
Set rngDest = Nothing
End Sub
Gruß
Christian
Betrifft: AW: Makro zum Zusammenfassen mehrerer Dateien
von: Florian
Geschrieben am: 16.11.2014 18:36:04
Hallo Christian,
vorerst mal vielen vielen Dank für deine Hilfe!
Wenn er mir alle Daten der Bereiche untereinanderschreiben würde wäre dies noch um Längen besser als sie nur zu überschreiben - also JA!
Ich hab seit deiner Antwort versucht deinen Code zum laufen zu bringen.
Ist an und für sich auch überhaupt kein Problem gewesen - Bereich und Pfad anpassen und los geht´s.
Allerdings fügt er mir immer nur die Daten der ersten Datei ein, die im Ordner ganz oben steht. Ich hab bis jetzt versucht dahinter zu kommen, muss aber zugeben dass meine VBA-Kenntnisse hier doch zu schwach sind. Bitte um erneute Hilfestellung!
Sollten wir das zum laufen bekommen flippe ich aus! Du wärst mein Held!
Grüße
Florian
Betrifft: funktioniert bei mir ohne Probleme ...
von: Christian
Geschrieben am: 17.11.2014 06:54:45
Florian,
heißen deine Dateien denn alle "Plan*.xlsm".
Gruß
Christian
Betrifft: AW: funktioniert bei mir ohne Probleme ...
von: Florian
Geschrieben am: 17.11.2014 08:37:24
Hallo Christian,
die Dateien im besagten Ordner lauten:
Plan 001.xlsm
Plan 002.xlsm
Plan 003.xlsm
.
.
.
Plan 999.xlsm (max.)
Hier nochmals der gesamte Code.
'Erstellt unter Excel 2007, Windows Vista
'fcs 2009-10-25
Sub Addieren_Listenmattenstückzahlen()
'In das Blatt Blockzuteilung wechseln
Sheets("Blockzuteilung").Select
'Wert aus Bereich in mehreren Dateien summieren ohne Öffnen der Dateien
'Variante mit festvorgegebenem Bereich
Call DatenAddieren_Listenmattenstückzahlen(BlattName:=ActiveSheet.Name, _
Bereich:=ActiveSheet.Range("T9:Y88"))
'Variante mit Bereichsauswahl
'Call DatenAddieren(BlattName:=ActiveSheet.Name, _
Bereich:=Application.InputBox( _
Prompt:="Bitte den zu summierenden Bereich selektieren", _
Title:="Daten aus mehreren Dateien addieren", _
Default:="T9:Y88", _
Type:=8))
Fehler:
With Err
If .Number <> 0 Then
Select Case .Number
Case 424 'Bereichsauswahl wurde abgebrochen
'do nothing
Case Else
MsgBox "Fehler-Nr.:" & .Number & vbLf & .Description
End Select
End If
End With
End Sub
Sub DatenAddieren_Listenmattenstückzahlen(BlattName As String, Bereich As Range)
Dim rngDest As Range
Dim sFormel As String, iPos As Integer
Dim lstrPath As String, lstrFile As String
lstrPath = Range("D1") ' Pfad anpassen!!!
lstrFile = Dir(lstrPath & "Plan*.xlsm")
If lstrFile = "" Then
MsgBox "Im Verzeichnis keine Plan*-Dateien vorhanden"
Exit Sub
End If
Set rngDest = Bereich
Do Until lstrFile = ""
iPos = InStrRev(lstrPath & lstrFile, Application.PathSeparator)
sFormel = "='" & Left(lstrPath & lstrFile, iPos) _
& "[" & Mid(lstrPath & lstrFile, iPos + 1) & "]" _
& BlattName & "'!" & Bereich.Address(ReferenceStyle:=xlR1C1)
' Forrmel eintragen
rngDest.FormulaArray = sFormel
' in Werte wandeln
rngDest.Value = rngDest.Value
' Zielbereich versetzen
Set rngDest = rngDest.Offset(Bereich.Rows.Count)
lstrFile = Dir
Loop
Set rngDest = Nothing
End Sub
Besten Dank im Voraus und schöne Grüße!
Florian
Betrifft: AW: funktioniert bei mir ohne Probleme ...
von: Christian
Geschrieben am: 17.11.2014 10:16:48
hallo Florian,
Dann fällt mir nur noch als mögl. Fehlerquelle ein, dass entweder:
in den einzelnen "Plan-Dateien" das Tabellenblatt "Blockzuteilung" fehlt,
oder in diesen Dateien der Bereich "T9:Y88" leer ist
und natürlich muss in Range("D1") auch der korrekte Pfad stehen inkl. abschließendem Backslash "\", das sollte aber nicht das Problem sein, da du ja eine Datei einlesen kannst
Gruß
Christian
Betrifft: AW: funktioniert bei mir ohne Probleme ...
von: Florian
Geschrieben am: 17.11.2014 10:56:32
Hallo Christian,
ich komme nicht dahinter!
Habe alles nochmals kontrolliert und auch komplett neue, leere Dateien erstellt. Fehler bleibt bestehen. Er liest immer nur den ersten Plan ein. Kannst du mir vielleicht deine Testdateien hochladen um diese in meinem Ordner - auf meinem Rechner zu testen?
Danke für dein Engagement!
Florian
 |
Betrifft: AW: funktioniert bei mir ohne Probleme ...
von: Christian
Geschrieben am: 17.11.2014 12:00:18
hallo Florian,
ich habe ja nur dein urspünglich gepostetes Makro "DatenAddierenNEU" als Vorlage genommen und hier ein paar Zeilen geändert.
Meine Testdatei "Plan_A.xlsm" sieht wie folgt aus (Tabellenblatt "Stückzahlen"):

Weitere Dateien "Plan_B.xlsm" und "Plan_C.xlsm" mit "B" statt "A" bzw. "C" statt "A" in gleichen Zellen im Blatt "Stückzahlen".
Kommentiere mal das "Workbook_Open" Makro unter "Diese Arbeitmappe" aus und durchlaufe den Code von "AddierenBreich" mit der F8-Taste in Einzelschritten und schau dir an, was da passiert.
Wie oft wird die Do Loop Schleife durchlaufen?
Bei der Zeile "rngDest.FormulaArray = sFormel" müssten dann die Formeln im Zielbereich eingetragen werden. In der nächsten Zeile werden die Formeln durch Werte ersetzt.
Des Weiteren kannst du mit "Debug.Print rngDest.Address" die Adresse des Zielbereichs
oder mit "Debug.Print sFormel" die entspr. Formel ausgeben lassen
Ansonsten - keine weitere Idee.
Gruß
Christian
 |
Beiträge aus den Excel-Beispielen zum Thema "Makro zum Zusammenfassen mehrerer Dateien"