Hallo Excel-Cracks,
ich habe ein kleines Makro geschrieben, das funktioniert auch wunderbar und tut was es soll. Nur leider ist es nicht sonderlich performant.
Das Makro konsolidiert Informationen aus einer beliebigen Anzahl an Formblättern, welche immer gleich aufgebaut sind (bzw. jede der 2 Sprachversionen ist immer gleich aufgebaut) in eine Tabelle. Hier wird noch eine Einordnung nach Namen vorgenommen. Dabei ist jeweils nur der Name der Dateien variabel.
Besonders ab einer Anzahl von ca. 100 Dateien dauert es echt eine ganze Zeit lang. Gibt es hier irgendwelche quick wins mit denen sich die Performance verbessern lässt?
Vielen Dank schonmal vorab!
Gruß Flo
Marko:
Application.ScreenUpdating = False
Dim N, zähler, Sprache As Long
Dim L, S, Dateipfad, sprache2 As String
'Zellen Bewertungsübersicht
Dim DEZBOE, DEZBRS, DEZBP, DEZBI, DEZBEC As String
'Einträge zählen und als Schleifenobergrenze festlegen
Set RangeLN = Worksheets("Matrix - Consolidate").range("D1:GE1")
zähler = Application.WorksheetFunction.CountA(RangeLN)
'variabler Pfad für den Ordner
Dateipfad = Sheets("Documentation").range("R55")
'Schleife
For counter = 0 To zähler - 1
'Datei mit Namen abhängig von Listeneintrag öffnen
L = Workbooks("DieseMappe.xlsm").Worksheets("Matrix - Consolidate").Cells(2, 4 + counter).Value
S = Workbooks("DieseMappe.xlsm").Worksheets("Matrix - Consolidate").Cells(1, 4 + counter).Value
Workbooks.Open Filename:=Dateipfad & "\Auswahl Sheet_" & L & "_" & S & ".xlsx"
'auf Sprachversion überprüfen
If ActiveSheet.Name = "Auswahl Sheet English" Then
Sprache = 1
sprache2 = "English"
Else:
Sprache = 0
sprache2 = "German"
End If
'variables Auslesen der Zellen
DEZBOE = Workbooks("DieseMappe.xlsm").Worksheets("Documentation").Cells(16, 29 + Sprache).Value 'T115
DEZBRS = Workbooks("DieseMappe.xlsm").Worksheets("Documentation").Cells(17, 29 + Sprache).Value 'T116
DEZBP = Workbooks("DieseMappe.xlsm").Worksheets("Documentation").Cells(18, 29 + Sprache).Value 'T117
DEZBI = Workbooks("DieseMappe.xlsm").Worksheets("Documentation").Cells(19, 29 + Sprache).Value 'T118
DEZBEC = Workbooks("DieseMappe.xlsm").Worksheets("Documentation").Cells(20, 29 + Sprache).Value 'T119
'Zuordnung Namen
'Sheets("Auswahl Sheet " & sprache2).Select
Select Case Sheets("Auswahl Sheet " & sprache2).Cells(9, 6 + Sprache * 2).Value
Case "Julia"
N = 0
Case "Hannes"
N = 5
Case "Martin"
N = 10
Case "Lars"
N = 15
Case "Anne"
N = 20
Case "Sophie"
N = 25
Case "Japonica"
N = 30
Case "Oliver"
N = 35
Case "Simone"
N = 40
Case "Thorsten"
N = 50
Case "Dieter"
N = 55
Case "Laura"
N = 65
End Select
'Kopieren und Einfügen der Werte
'Kategorie1
Worksheets("Auswahl Sheet " & sprache2).range(DEZBOE).Copy
Workbooks("DieseMappe.xlsm").Worksheets("Matrix - Consolidate").Cells(3 + N, 4 + counter).PasteSpecial Paste:=xlValues
'Kategorie2
Workbooks("Auswahl Sheet_" & L & "_" & S & ".xlsx").Worksheets("Auswahl Sheet " & sprache2).range(DEZBRS).Copy
Workbooks("DieseMappe.xlsm").Worksheets("Matrix - Consolidate").Cells(4 + N, 4 + counter).PasteSpecial Paste:=xlValues
'Kategorie3
Workbooks("Auswahl Sheet_" & L & "_" & S & ".xlsx").Worksheets("Auswahl Sheet " & sprache2).range(DEZBP).Copy
Workbooks("DieseMappe.xlsm").Sheets("Matrix - Consolidate").Cells(5 + N, 4 + counter).PasteSpecial Paste:=xlValues
'Kategorie4
Workbooks("Auswahl Sheet_" & L & "_" & S & ".xlsx").Worksheets("Auswahl Sheet " & sprache2).range(DEZBI).Copy
Workbooks("DieseMappe.xlsm").Sheets("Matrix - Consolidate").Cells(6 + N, 4 + counter).PasteSpecial Paste:=xlValues
'Datei schließen ohne Speichern
Workbooks("Auswahl Sheet_" & L & "_" & S & ".xlsx").Activate
ActiveWorkbook.Close (False)
Next counter
Application.ScreenUpdating = True