Excel 2010 - importiere Werte per VBA aus vielen Dateien?

[Surtia]

Aloha Community,
In der Praxis geht es um 17 Dateien, 156 Registerblätter und 624 abgefragte Zellen (je Registerblatt 5). Noch...
Der Grund warum ich diese Problematik im VBA lösen möchte, ist das unperformante und zeitaufwendige Importieren per Formeln.

Meine Vorstellung:
Man kicke in Datei C (Zieldatei) auf einen Button namens "Importieren" und alle Werte werden herbei genuggelt.

Die Problematik heruntergebrochen auf 2 Dateien, wenige Registerblätter und je 2 Zellen...
Quelldatei A und B sind geschlossen und liegen in einem Unterordner.
Es sollen nur die Werte in der Zelle, keine Formeln importiert werden.

Zu importierende Zellen aus 2 Dateien mit unterschiedlichen Registerblättern (RB):
Datei A - RB 10 / RB 22 / RB 50 / RB 140 - Zellen C33 & X5
Datei B - RB 25 / RB 26 / RB 490 - Zellen C33 & X5

Zieldatei:
Datei C
Die 5 Zellen C33 aus Datei A sollen in die Zellen E12 bis H16
Die 5 Zellen X5 aus Datei A sollen in die Zellen E13 bis h13
Die 4 Zellen C33 aus Datei B sollen in die Zellen E18 bis G18
Die 4 Zellen X5 aus Datei B sollen in die Zellen E19 bis G19

Wenn mir jemand ein kleines Makro dazu schreiben könnte wäre ich sehr dankbar.
Ich hoffe, es ist nicht zu komplex und aufwendig.

 

[majusss]

Schreiben wird dir das denke ich keiner Versuch es mal selbst und wir helfen dir, wenn du festhängst.

 

[Surtia]

Das habe ich befürchtet.
Problem ist, dass allgemeine Themen immer nur einen Teil dessen behandeln.
Ergo eine gestocherte Zusammenwurstelei meinerseits, mit einem vermutlich wenig optimalen Ergebnis.
Mein hoffnungsvoller Vesuch war es, das zu vermeiden.

 

[_killy_]

Mein Vorgehen:
- eine Excel Datei anlegen welche alle Dateinamen sowie die Bereiche enthält
- Funktion schreiben die per Schleife:
-- alle Dateien durchgeht
-- die definierten Bereiche kopiert und in die Zieldatei schreibt
-- jede Datei nach erfolgreichen kopieren dann auch schließt

So schwierig ist es nicht. Fang einfach an:
1) schreib eine Funktion die eine Excel Datei öffnen und schließen kann
2) schreib eine weitere Funktion die Werte aus einer fremden Datei kopieren kann
3) ... mach ne Schleife drum

 

[Surtia]

Danke schon mal.

Ist das Öffnen und Schließen der Quelldateien zwingend notwendig?
Denn, wenn ich ich die Werte per Formeln importieren lasse werden diese nicht geöffnet.
Sollte es notwendig sein, kann ich die Idee jetzt schon verwerfen, da das Öffnen einer jeden Datei sehr zeitaufwendig ist (schwache Rechner/ Dateigröße u.a. 12mb und größer).

 

[_killy_]

Ohne eine Datei zu öffnen kannst du keine Werte aus dieser kopieren. Die Formel-Lösung öffnet die Datei ja auch.
Öffnen heißt nicht zwingend, dass auch ein Excel Fenster geladen werden muss, es liegt nur eine Referenz auf der Datei. Sollte performanter als die Formel Lösung sein.

Wenn du die Dateien gar nicht öffnen möchtest, dann sieht die Alternative wie folgt aus:
- alle Quelldateien schreiben die Daten selber weg ... als CSV, TXT ... immer beim Schließen der Datei
- dann kann die Zieldatei die CSV/TXT Dateien einlesen

 

[Scientist]

Per VBA eine Formel setzen und diese durch Werte zu ersetzen ist eine einfache und recht performante Loesung, um Werte aus einer anderen Datei zu kopieren.

Zum Setzen einfach: Zelle.Values= "='pfad[datei]Rohdaten'!A1"
Um durch Wert zu ersetzen: Zelle.Copy und Zelle.PasteSpecial xlPasteValues

Wenn es sehr viele Zellen sind, ist eine Arrayformel sinnvoll.
Damit lassen sich auch einige zehntausend Zellen in wenigen Sekunden aus einer anderen Datei kopieren.

 

[Surtia]

Ok, danke.
Dann war meine Vorstllung des visuellen Öffnens falsch.

@Scientist
Ich glaube eine Arrayformel für die oben beschriebene Problematik wäre ungeeignet, oder?

 

[Scientist]

Ja, weil die Bereiche nicht zusammenhaengen.
Wenn der Einfluss auf die Performance zu groß ist, koennte man es wie _Killy_ geschrieben hat machen.

Bzw. statt eine Datei zu erstellen, koennte man auch die Zellen innerhalb der Dateien vorselektieren und dann "in einem Rutsch" ueber die Formeln ziehen.
Dann waere es auch einfacher, statt alle Zellverweise einzeln zu erzeugen.

 

[Surtia]

Ok, es funktioniert aber ich bin mit dem Makro sehr unzufrieden.

Problem:
- Wie vermeide ich das Öffnen der Dateien, da das mit den Originalen sehr zeitaufwendig ist. Zeitaufwendiger als die Werte per Formeln einzulesen.
- Für die eigentlichen 17 Dateien zu grobschlächtig. Wie kann ich die Abfragen kompakter (Schleife) verpacken?

Sub Import()

Dim DateiA As Workbook
Dim DateiB As Workbook

Set DateiC = ThisWorkbook
Set DateiA = Workbooks.Open("H:\...\DateiA.xlsx", ReadOnly:=True)
Set DateiB = Workbooks.Open("H:\...\DateiB.xlsx", ReadOnly:=True)

DateiC.Sheets(1).Cells(12, 5).Value = DateiA.Sheets(1).Cells(33, 3).Value
DateiC.Sheets(1).Cells(12, 6).Value = DateiA.Sheets(2).Cells(33, 3).Value
DateiC.Sheets(1).Cells(12, 7).Value = DateiA.Sheets(3).Cells(33, 3).Value
DateiC.Sheets(1).Cells(12, 8).Value = DateiA.Sheets(4).Cells(33, 3).Value

DateiC.Sheets(1).Cells(13, 5).Value = DateiA.Sheets(1).Cells(5, 24).Value
DateiC.Sheets(1).Cells(13, 6).Value = DateiA.Sheets(2).Cells(5, 24).Value
DateiC.Sheets(1).Cells(13, 7).Value = DateiA.Sheets(3).Cells(5, 24).Value
DateiC.Sheets(1).Cells(13, 8).Value = DateiA.Sheets(4).Cells(5, 24).Value

DateiC.Sheets(1).Cells(18, 5).Value = DateiB.Sheets(1).Cells(33, 3).Value
DateiC.Sheets(1).Cells(18, 6).Value = DateiB.Sheets(2).Cells(33, 3).Value
DateiC.Sheets(1).Cells(18, 7).Value = DateiB.Sheets(3).Cells(33, 3).Value

DateiC.Sheets(1).Cells(19, 5).Value = DateiB.Sheets(1).Cells(5, 24).Value
DateiC.Sheets(1).Cells(19, 6).Value = DateiB.Sheets(2).Cells(5, 24).Value
DateiC.Sheets(1).Cells(19, 7).Value = DateiB.Sheets(3).Cells(5, 24).Value

DateiA.Close
DateiB.Close

Set DateiA = Nothing
Set DateiB = Nothing
Set DateiC = Nothing

End Sub

 

[Scientist]

Ok, es funktioniert aber ich bin mit dem Makro sehr unzufrieden.

Problem:
- Wie vermeide ich das Öffnen der Dateien, da das mit den Originalen sehr zeitaufwendig ist. Zeitaufwendiger als die Werte per Formeln einzulesen.
- Für die eigentlichen 17 Dateien zu grobschlächtig. Wie kann ich die Abfragen kompakter (Schleife) verpacken?
Sub Import()

Ich versteh gar nicht, warum du das ueberhaupt gemacht hast, weil das dir von Anfang an klar war ...

Mal (mehr oder weniger) zusammengefassung:

Option 1:
- Quelldateien exportieren beim Schließen die gewuenschten Informationen,
die ueber ueber die "Import CSV/TXT"-Funktion importiert werden
- Exportdateien logisch bezeichnen, dann ist keine Tabelle notwendig oder in einen extra Unterordner,
in dem nichts anderen enthalten sein wird.

Option 2:
- Tabelle erstellen mit Dateinamen und den jeweiligen Bereichen
- 2 Schleifen erstellen, einmal ueber alle Dateien und einmal ueber alle Bereiche
- 2. Schleife setzt in Zielzellen ein Zellverweis auf die Quellzellen (siehe Bsp. in #7)
- Am Ende alle Zielzellen kopieren und an selber Stelle als Wert einfuegen (siehe Bsp. in #7)

Option 2.1
- In den Quelldateien die Quellzellen zusammenfassen
- Tabelle erstellen mit Dateinamen
- Schleife ueber den Bereich der Dateinamen
- die in die Zielzellen ein Zellverweis auf die Quellzellen als Array setzt (Range.FormulaArray = Quellbereich)
- Am Ende alle Zielzellen kopieren und an selber Stelle als Wert einfuegen (siehe Bsp. in #7)

 

[Surtia]

Hehe. Naja, wie gesagt, meine Kenntnisse sind noch sehr schmächtig.
Eine Schulung hatte ich nie und fange mit Selbstversuchen quasi von Null an.
Das Internet bietet eine Menge aber zu dieser speziellen Problematik sind einfach verständliche Beispiele kaum zu finden.

Schon mal vielen Dank für deine Mühe bzw. Antwort.

Wenn mein Verständnis richtig ist fällt Option 1 aus. C soll aus A und B nuggeln, ohne, dass diese Dateien selbst exportieren oder geöffnet werden müssen. Option 2 scheint mir logisch und am vielversprechendsten, nur fehlt mir leider die grundlegende Kenntnis wie ich diese Lösung als VBA-Code verpacke. Schnüff...

Ist es Dir möglich mir beispielhaft ein kleines Makro nur für Datei A und Zelle C33 zu tippen?
Ich könnte selbst versuchen es auf X5 und Datei B zu erweitern.

 

[Scientist]

Dim pfad, datei, blatt, zelle as String

pfad = Tabelle2.Range("A1").value ' in Form von C:\Beispiel\
datei = Tabelle2.Range("A2").value ' Datei.xlsx
blatt = Tabelle2.Range("A3").value ' Rohdaten
zelle = Tabelle2.Range("A4").value 'A1

Tabelle1.Cells(1,1).Values= "='" & pfad & "[" & datei & "]" & blatt & "'!" & zelle
Tabelle1.Cells(1,1).Copy
Tabelle1.Cells(1,1).PasteSpecial xlPasteValues

Ungetestet.
Und damit verabschiede ich mich.

 

[Surtia]

Mh, damit kann ich nix anfangen.
Wenn ich in Zeile 3 bis 6, jeweils in die "" den Pfad, Dateiname usw. eingebe, erscheint lediglich "Laufzeitfehler" oder "Objektvariable nicht festgelegt".

 

[Surtia]

Der aktuelle Stand sieht so aus, dass folgendes Makro alle Zellen C33 aller Registerblätter der Dateien A und B importiert.
Problem ist, dass auch bei dieser Lösung die Quelldateien geöffnet werden müssen.

Sub Alle_Dateien()
Application.ScreenUpdating = False
 
Dim QD, QP, QT As String 'Quelldatei, Quellpfad, Quelltyp
Dim QRB, ZRB As Worksheet, QAM As Workbook 'Quellregisterblatt, ZielRB, Quellarbeitsmappe
Dim RBi, RBj As Integer 'i = Anz RB aller Dateien | j = Anz RB einer Datei

QP = "C:..."
QT = "xlsx"
Set ZRB = ThisWorkbook.Sheets(1)
RBi = 1

QD = Dir(QP & "\*." & QT)
    Do Until QD = ""
        Set QAM = Workbooks.Open(QP & "\" & QD)
        For RBj = 1 To Sheets.Count
            Set QRB = QAM.Sheets(RBj)
            ZRB.Cells(4, 2 + RBi) = QRB.Cells(33, 3)
            RBi = RBi + 1
        Next
        QAM.Close False
        QD = Dir
    Loop
 
Application.ScreenUpdating = True
End Sub

Nachstehendes Makro muss die Dateien nicht öffnen, jedoch kann ich aktuell nur eine Datei ansprechen und auch nur ein Registerblatt.

Sub Zelle_auslesen()
Application.ScreenUpdating = False

Dim pfad, datei, blatt As String, bereich As Range, zelle As Object

'Quelle
pfad = "C:\..."
datei = "Datei A.xlsx"
blatt = "RB 10"

bezug = "C33"
ActiveCell.Value = GetValue(pfad, datei, blatt, bezug)

Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------
Private Function GetValue(pfad, datei, blatt, zelle)
Dim arg As String

If Right(pfad, 1) <> "\" Then pfad = pfad & "\" 'füge an Pfad \ an
    If Dir(pfad & datei) = "" Then 'Datei vorhanden?
    GetValue = "no file"
    Exit Function
End If

arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1) 'zu schreibendes Argument
GetValue = ExecuteExcel4Macro(arg) 'Makro soll auf diese Funktion zugreifen

End Function

Wie bekomme ich beide Dateien kombiniert bzw. ist dies überhaupt möglich unter der Bedingung, dass keine der Zieldateien geöffnet werden soll?

 

[Surtia]

Nach langer Tüftelei ist das Makro nun endlich fertig.
Falls jemand selbiges basteln muss, möchte, will habe ich zum Nachvollziehen die Zieldateie inkl. der Quelldateien angehangen.
Einzig muss im Makro der Pfad wo die Quelldateien liegen angepasst werden.

Wenn möglich, würde ich einen Moderator bitten den Titel des Threads zu veändern:
Excel 2010 VBA - Import verschiedener Zellen aus mehreren Dateien ohne diese zu öffnen

Sub Import()
Application.ScreenUpdating = False
'ActiveWorkbook.Unprotect Password:=""

Dim QP, QD, QRB As String 'Quellpfad, Quelldatei, Quellregisterblatt
Dim ZRB, Zelle As Object  'Zielregisterblatt
Dim R As Range            'R = Bereich der QRB im ZRB
Dim i, j, k, l As Integer 'i = Anz ZRB, j = Zeilen weiterrücken, k = Spalten weiterrücken, l = Anz QRB

For i = 1 To Sheets.Count
    Set ZRB = ThisWorkbook.Sheets(i)
    'ZRB.Unprotect Password:=""
  
    If i = 1 Then
        QP = "C:\...\Testfiles Import\Source 1"
    Else: i = 2
        QP = "C:\...\Testfiles Import\Source 2"
    End If

    j = 0
    QD = Dir(QP & "\*." & "xlsx")
    Do Until QD = ""
      
        Set R = Range(ZRB.Cells(11 + j, 5), ZRB.Cells(11 + j, 24))
        l = Application.WorksheetFunction.CountA(R)
          
        j = j + 6
        For k = 0 To l - 1
            QRB = ZRB.Cells(5 + j, 5 + k).Value
            ZRB.Cells(6 + j, 5 + k) = GetValue(QP, QD, QRB, "C33")
            ZRB.Cells(7 + j, 5 + k) = GetValue(QP, QD, QRB, "C41")
            ZRB.Cells(8 + j, 5 + k) = GetValue(QP, QD, QRB, "C188")
            ZRB.Cells(9 + j, 5 + k) = GetValue(QP, QD, QRB, "Y5")
        Next
        QD = Dir
    Loop
    'ZRB.Protect Password:=""
Next

'ActiveWorkbook.Protect Password:=""
Application.ScreenUpdating = True
End Sub

'Funktion GetValue zum Auslesen aus geschlossener QD
Private Function GetValue(QP, QD, QRB, Zelle)
Dim arg As String

If Right(QP, 1) <> "\" Then
    QP = QP & "\"
End If

arg = "'" & QP & "[" & QD & "]" & QRB & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)

End Function