Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

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"