Performance Optimieren, Array verwenden?
29.06.2017 09:46:54
Alex
für eine bessere Übersicht möchte ich verschiedene Teilprojektpläne in einem Zusammenführen.
Je nach Projekt gibt es zwischen 5-15 Teilprojekte und der maximale Bereich der importiert werden soll aus diesen Exceldateien ist "C10:CA228".
Ich bin bereits auf eine Funktion gestoßen, die es mir erlaubt aus Exceldateien zu importieren, ohne das ich diese jedes mal öffnen muss.
Problem ist: Das ganze dauert extrem lang, da die Formel jeden Wert einzeln überträgt.
Idee:
- das ganze in einem Array einlesen und dann komplett einmal schreiben?
--> Um das ganze mit einem Array zu machen, brauche ich wahrscheinlich nen halben Tag, da ich mich vor der Verwendung von Arrays immer gedrückt habe :D
wäre super, wenn ihr mir hier auf die Sprünge helfen könnte, um die Laufzeit zu verringern. Ob mit Arrays oder was anderes...
Anhang:
- Quelldatei (kleiner Ausschneit eines Teilprojektplans)
https://www.herber.de/bbs/user/114566.xlsx
- Zieldatei mit Code
https://www.herber.de/bbs/user/114565.xlsm
Sub Bereich_auslesen()
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
'** Angaben zur auszulesenden Zelle
pfad = "C:\Users\Meier\Desktop"
datei = "Projektplan_KW26.xlsm"
blatt = "1_Projektplan und -monitoring"
Set bereich = Range("C10:BB14")
'** 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
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das 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
Alex