Daten aus geschlossener Datei
16.03.2018 23:32:13
Dietmar
tüftele schon eine ganze Weile an folgendem:
Möchte aus einer geschlossenen Datei Datenwerte in eine geöffnete Datei übertragen.
In der geöffneten Datei ist der VBA-Code.
In der geschlossenen Datei (also eigenständige Mappe)
- befinden sich Werte in den Spalten A bis G
- sind Werte in derzeit 500 Zeilen vorhanden, die aber weiter aufgefüllt werden
Folgender Code, den ich gefunden habe, funktioniert, hat aber zwei Mankos:
- dauert recht lange
- funktioniert nur, wenn geschlossene Datei vorher einmal auf- und zugemacht wurde
Sub Bereich_auslesen()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, Bereich As Range, zelle As Object
'** Angaben zur auszulesenden Zelle
Application.ScreenUpdating = False
pfad = "C:\MLC-ProvCalc"
datei = "MLC-ProvCalcDatenpool.xlsx"
blatt = "Tabelle1"
Range("J2").FormulaArray = "=MAX(ROW(1:65535)*('[" & datei & "]" & blatt & "'!A1:A65535""""))" _
Set Bereich = Range("A2:G" & Range("J2").Value)
'** Bereich auslesen
For Each zelle In Bereich
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
Application.ScreenUpdating = True
Range("J2").ClearContents
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass die datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , _
xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Bzgl. der Geschwindigkeit: Liegt vllt. an der Array-Formel, die temporär verwendet wird?
Dietmar