Microsoft Excel

Herbers Excel/VBA-Archiv

Consolidieren mit einem Array

Betrifft: Consolidieren mit einem Array von: FloT
Geschrieben am: 25.07.2014 15:55:19

Servus,
ich habe gleich 2 Probleme mit meinem Makro. Ich hoffe Ihr könnt mir helfen.

1. Hauptproblem
Ich möchte mit consolidate Daten aus verschiedenen Dateien(gleiche Datenstruktur) eines Ordner mit Summe konsolidieren. Es sind so ca 100 Dateien und es kommen ständig welche dazu.
Mein Ansatz ist alle Dateien in einen Array zu schreiben und dann an consolidate zu übergeben.

Leider bekomme ich Fehler 1004: Laufzeit oder Objektdefinierter Fehler
Ich hoffe Ihr könnt mir weiterhelfen. Ich arbeite das erste mal mit Arrays in VBA...

2. Problem
Wie stelle ich sicher das die For i Schleife nur so lang läuft wie das Array lang ist?



Sub consolidate()
Dim sFile As String, sPath As String, AllWb(100) As String

      If Right(sPath, 1) <> "/" Then
      sPath = ThisWorkbook.Path & "\data\"
        End If
        sFile = Dir(sPath & "*.xlsx")
            
         For i = 0 To sFile = "" 'das habe ich probiert - funktioniert leider nicht.
                AllWb(i) = "'" & sPath & "[" & sFile & "]overall'!C1:C3"
                sFile = Dir()
         Next i
         
`diese Funktion habe ich als test für den String - sie funktioniert, leider nur mit einer  _
Tabelle.
     Selection.consolidate Sources:=Array( _
     "'" & sPath & "[" & sFile & "]overall'!C1:C3" _
     ), Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
 
 ' Diese Funktion würde ich gern benutzen, funktionier taber nicht
     Selection.consolidate Sources:=Array(AllWb), Function:=xlSum, TopRow:=False, LeftColumn:= _
False, CreateLinks:=False
       
 
 End Sub

Schon mal herzlichen Dank im voraus!

Florian

  

Betrifft: nur für 2. ne Lösungsidee... von: Oberschlumpf
Geschrieben am: 25.07.2014 23:59:10

Hi Florian

ersetz mal deinen oberen Codeteil durch diesen:

Sub consolidate()
Dim sFile As String, sPath As String, AllWb() As String, liIdx As Integer

'       If Right(sPath, 1) <> "/" Then <-- bist du sicher, dass die Zeile richtig ist?
        If Right(sPath, 1) <> "\" Then <-- wäre es so nicht besser?
            sPath = ThisWorkbook.Path & "\data\"
        End If

    sFile = Dir(sPath & "*.xlsx")
            
         Do Until sFile = ""
             ReDim Preserve AllWb(liIdx)
             AllWb(liIdx) = "'" & sPath & "[" & sFile & "]overall'!C1:C3"
             liIdx = liIdx + 1
             sFile = Dir()
         Loop
Erklärung:
Do/Loop ist auch eine Schleife.
For/Next wird so lange wiederholt, bis ein Zähler seinen Max-Wert erreicht hat. In deinem Code = 100.
For/Next läuft IMMER bis 100. Egal, ob nur 20 Dateien im Verzeichnis oder 120.

Do/Loop wird so lange wiederholt, bis IRGENDEINE Bedingung erfüllt ist, die DU bestimmst.
Z Bsp, bis alle Dateien im Verzeichnis gefunden sind - keine mehr, keine weniger.

So hast du also schon mal das Problem gelöst, dass du 100 im Code nicht ändern musst, wenn es z Bsp 109 Dateien sind, oder 131, oder oder oder...du müsstest immer im Code die Zahl anpassen.

Do/Loop wiederholt IMMER nur so oft, wie Dateien vorhanden sind.


die Array-Bildung:

In der DIM-Zeile steht nur AllWb() - ohne eine Zahl in den Klammern.
Das hat den Vorteil, dass du später im Code mit ReDim die Anzahl der Array-Einträge dynamisch anpassen kannst.

- den Parameter Preserve erklär ich hier nicht extra...schau dir die Excel-Hilfe zu ReDim an -

Also, Arraybildung...

1. ReDim Preserve AllWb(liIdx) - liIdx hat den Wert 0, es wird der erste Arrayeintrag erzeugt
2. AllWb(liIdx) = "'" & sPath...usw - liIdx immer noch 0, der erste Arrayeintrag erhält den ersten Dateinamen
3. liIdx = liIdx + 1 - liIdx wird um 1 erhöht, liIdx hat jetzt den Wert 1
4. sFile = Dir() - es wird nach der nächsten Datei gesucht - und gefunden
5. ReDim Preserve AllWb(liIdx) - liIdx hat den Wert 1, es wird der zweite Arrayeintrag erzeugt
6. AllWb(liIdx) = "'" & sPath...usw - liIdx immer noch 1, der zweite Arrayeintrag erhält den zweiten Dateinamen
7. liIdx = liIdx + 1 - liIdx wird um 1 erhöht, liIdx hat jetzt den Wert 2
8. sFile = Dir() - es wird nach der nächsten Datei gesucht - und gefunden


das geht so lange weiter, bis sFile = "" ist, weil keine Datei mehr gefunden wurde, die nicht schon mal vorher gefunden wurde.

Verstanden? :-)

Ciao
Thorsten


  

Betrifft: AW: nur für 2. ne Lösungsidee... von: FloT
Geschrieben am: 28.07.2014 09:46:41

Hey,
Danke für Deine Hilfe:
Verstanden habe ich es glaube ich einigermaßen^^, zumindest kann ich es nachvollziehen.
Zusammen mit den Tipps von Nepomuk bin ich jetzt schon weiter.
Jetzt sagt er mit das er die Datei nicht öffnen kann, wobei der Dateiname falsch ist:

'[Workbook]tabelle'kann nicht geöffnet werden.
Irgendwie nimmt er den Tabellennamen zum Dateinamen dazu und kann ihn deswegen nicht öffnen.
Kannst Du noch mal schauen?


  

Betrifft: AW: Consolidieren mit einem Array von: Nepumuk
Geschrieben am: 26.07.2014 10:42:03

Hallo,

1. Muss das Array vom Typ Variant sein.
2. Darf es keine leeren Einträge enthalten.
3. Müssen die Bezüge in R1C1 Schreibweise abgefasst sein.
4. Würde ich als Ziel der Ausgabe nicht die Selection-Eigenschaft benutzen, denn das kann auch ein Shape oder OLE-Objekt sein. Besser z.B. Tabelle1.Cells(1, 1).Consolidate .....

Gruß
Nepumuk



  

Betrifft: ...oder ggf ActiveWindow.RangeSelection! Gruß owT von: Luc:-?
Geschrieben am: 26.07.2014 18:14:21

:-?


  

Betrifft: Funktioniert noch nicht von: FloT
Geschrieben am: 28.07.2014 09:21:03

Hey,
Danke für die Unterstützung.
Das habe ich jetzt - immer noch gleiches Ergebnis :(

Sub consolidate()
Dim sFile As String, sPath As String, AllWb(2) As Variant

      If Right(sPath, 1) <> "/" Then
      sPath = ThisWorkbook.Path & "\data\"
        End If
        sFile = Dir(sPath & "*.xlsx")
            
         For i = 0 To 1
                AllWb(i) = "'" & sPath & "[" & sFile & "]overall'!S1:S3"
                sFile = Dir()
         Next i
         

    Selection.consolidate Sources:=Array(AllWb), Function:=xlSum, TopRow:=False, LeftColumn:= _
False, CreateLinks:=False
       

     
 End Sub
zu1: Gemacht
zu2: Erst mal temporär sichergestellt
zu3: gemacht - ist das so richtig?
zu4: Du hast völlig recht, mache ich dann in der finalen Datei.


  

Betrifft: AW: Funktioniert noch nicht von: Nepumuk
Geschrieben am: 28.07.2014 09:35:17

Hallo,

S1:S3 ist keine R1C1 Schreibweise. Wenn das in der Tabelle die Zellen S1:S3 sein sollen, dann so:

R1C19:R3C19

R1 = Zeile 1
C19 = Spalte 19 ~ Spalte S
R3 = Zeile 3
C19 wie gehabt.

Das sollte ein Excelprofi aber wissen, denn wenn ich in den Exceloptionen die Bezugsart für Formeln von A1 auf Z1S1 umstelle, dann siehst du in deinen Formeln genau diese Schreibweise.

Gruß
Nepumuk


  

Betrifft: AW: Funktioniert noch nicht von: FloT
Geschrieben am: 28.07.2014 10:32:17

Hab es entsprechend angepasst zu S(1):S(3)
Zusammen mit den Tipps von Oberschmlumpf bin ich jetzt schon weiter.
Jetzt sagt er mit das er die Datei nicht öffnen kann, wobei der Dateiname falsch ist:

'[Workbook]tabelle'kann nicht geöffnet werden.
Irgendwie nimmt er den Tabellennamen zum Dateinamen dazu und kann ihn deswegen nicht öffnen.
Kannst Du noch mal schauen?

Sub consolidate()
Dim sFile As String, sPath As String, AllWb() As Variant, liIdx As Integer


        If Right(sPath, 1) <> "\" Then
            sPath = ThisWorkbook.Path & "\data\"
        End If

    sFile = Dir(sPath & "*.xlsx")
            
         Do Until sFile = ""
             ReDim Preserve AllWb(liIdx)
             AllWb(liIdx) = "'" & sPath & "[" & sFile & "]" & "overall'!S(1):S(3)"
             liIdx = liIdx + 1
             sFile = Dir()
         Loop


    Selection.consolidate Sources:=Array(AllWb), Function:=xlSum, TopRow:=False, LeftColumn:= _
False, CreateLinks:=False
       
     
 End Sub



  

Betrifft: AW: Funktioniert noch nicht von: Nepumuk
Geschrieben am: 28.07.2014 10:39:04

Hallo,

verstehst du es wirklich nicht?

Auch S(1):S(3) ist keine gültige R1C1 Schreibweise. Denn S ist weder ein R (Row) noch ein C (Column).

Ich geb's auf.

Gruß
Nepumuk


  

Betrifft: P.S.: von: Nepumuk
Geschrieben am: 28.07.2014 10:52:23

Ich nochmal

konsolidieren von geschlossenen Dateien ist nicht möglich. Das geht weder manuell noch per VBA.

Gruß
Nepumuk


  

Betrifft: Problem gelöst von: FloT
Geschrieben am: 28.07.2014 11:40:46

Hey,
es funktioniert!
Danke an Oberschlumpf und Nepumuk :)
Hier der code, falls ihn jemand verwenden möchte (bei mir konsolidiert er geschlossene Dateien):

Sub consolidate()
Dim sFile As String, sPath As String, AllWb() As Variant, liIdx As Integer


        If Right(sPath, 1) <> "\" Then
            sPath = ThisWorkbook.Path & "\data\"
        End If

    sFile = Dir(sPath & "*.xlsx")
            
         Do Until sFile = ""
             ReDim Preserve AllWb(liIdx)
             AllWb(liIdx) = "'" & sPath & "[" & sFile & "]" & "overall'!C1: C3 "
             liIdx = liIdx + 1
             sFile = Dir()
         Loop


    Worksheets("test").Cells(1, 1).consolidate Sources:=Array(AllWb), Function:=xlSum, TopRow:= _
True, LeftColumn:=True, CreateLinks:=False
       
     
 End Sub



  

Betrifft: Funktioniert noch nicht von: FloT
Geschrieben am: 28.07.2014 09:31:10

Hey,
Danke für die Unterstützung.
Das habe ich jetzt - immer noch gleiches Ergebnis :(

Sub consolidate()
Dim sFile As String, sPath As String, AllWb(2) As Variant

      If Right(sPath, 1) <> "/" Then
      sPath = ThisWorkbook.Path & "\data\"
        End If
        sFile = Dir(sPath & "*.xlsx")
            
         For i = 0 To 1
                AllWb(i) = "'" & sPath & "[" & sFile & "]overall'!S1:S3"
                sFile = Dir()
         Next i
         

    Selection.consolidate Sources:=Array(AllWb), Function:=xlSum, TopRow:=False, LeftColumn:= _
False, CreateLinks:=False
       

     
 End Sub
zu1: Gemacht
zu2: Erst mal temporär sichergestellt
zu3: gemacht - ist das so richtig?
zu4: Du hast völlig recht, mache ich dann in der finalen Datei.