Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1604to1608
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro beschleunigen

Makro beschleunigen
08.02.2018 10:33:03
Frank
Hallo Zusammen!
Da die Datei zum posten zu groß ist, hoffe ich das auch der Code ausreichend ist um für euch Experten zu erkennen, ob und wie man das Makro beschleunigen kann?
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
If ComboBox2 = "" Then
MsgBox "Sie müssen erst einen Monatsersten auswählen!"
Exit Sub
End If
Sheets("Urlaubsplanung").Cells(7, 9) = CDate(ComboBox2)
Range("I8").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C="""","""",IF(MONTH(R[-1]C+1)MONTH(R[-1]C),"""",R[-1]C+1))"
Range("I8").Select
Selection.AutoFill Destination:=Range("I8:I37"), Type:=xlFillDefault
Dim lng, lng1 As Long
Dim i As Integer
For lng = 7 To 5850
For lng1 = 7 To 37
For i = 2 To 7
If Sheets("Urlaubsplanung").Cells(lng, 1) > Sheets("Urlaubsplanung").Cells(3, 9)  _
Then Exit For
If Sheets("Urlaubsplanung").Cells(lng1, 9) = Sheets("Urlaubsplanung").Cells(lng, 1)  _
Then
Sheets("Urlaubsplanung").Cells(lng1, i + 8) = Sheets("Urlaubsplanung").Cells( _
lng, i)
End If
Next i
Next lng1
Next lng
Application.ScreenUpdating = True
Sheets("Urlaubsplanung").Range("A7").Select
End Sub
Ich bedanke mich schon jetzt für eure Hilfe!
L. G. Frank H.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
ohne select wird auch schon beschleunigt ;-)
08.02.2018 10:48:26
Matthias
Hallo
Als Erstes lässt man mal Select weg.
With Range("I8")
.FormulaR1C1 = "=IF(R[-1]C="""","""",IF(MONTH(R[-1]C+1)MONTH(R[-1]C),"""",R[-1]C+1))"
.AutoFill Destination:=Range("I8:I37"), Type:=xlFillDefault
End With
Gruß Matthias
AW: Makro beschleunigen
08.02.2018 10:48:32
Rainer
Hallo Frank,
schalte das automatische Neuberechnen noch aus:
Application.Calculation = xlCalculationManual
'Code
Appication.Calculation = xlCalculationAutomatic
Gruß,
Rainer
AW: Makro beschleunigen
08.02.2018 11:02:48
Frank
Hallo Ihr Zwei!
danke für die schnellen Antworten. Nur leider kann ich gefühlt keine Beschleunigung feststellen.
Vielleicht hat ja jemand noch 'ne zündende Idee für mich?
Danke und Gruß.
Anzeige
AW: Makro beschleunigen
08.02.2018 11:50:38
Zwenn
Hallo Frank,
Du hast drei ineinander verschachtelte Schleifen, die zusammen 1.087.356 Durchläufe ergeben.
(5.850 - 6) * (37 - 6) * (7 - 1) = 5.846 * 31 * 6 = 1.087.356
Da ich nicht weiß, was Du eigentlich mit Deinem Code erreichen willst (keine Erklärung im Posting, keine Kommentare im Quellcode), kann ich Dir lediglich den Rat geben, die Schleifendurchläufe zu verringern.
Versuche einen Weg zu finden, die Schleifen möglichst nicht zu verschachteln und/ oder überlege Dir, ob wirklich alle Durchläufe benötigt werden, also ob Du eine Schleife unter bestimmten Bedingungen mit Exit For früher verlassen kannst.
Viele Grüße,
Zwenn
Anzeige
AW: Makro beschleunigen
08.02.2018 12:00:35
Frank
Hallo Zwenn!
Danke dir, ich habe die 3. Schleife entfernt und in einzelne Zeilen des Codes umgewandelt. Jetzt läuft das Ganze zügiger ab und ich kann damit nun leben!
Gruß und noch einen schönen Tag wünscht Frank H.
AW: Makro beschleunigen
08.02.2018 18:01:54
Daniel
Hi
1. deine erste Abfrage:
If Sheets("Urlaubsplanung").Cells(lng, 1) > Sheets("Urlaubsplanung").Cells(3, 9) Then Exit For

gehört zwischen die erste und zweite Schleife.
Denn wenn diese Bedingung nicht erfüllt ist, braucht die zweite und dritte Schleife erst gar nicht starten.
Diese Prüfung wird dann nur 5844x ausgeführt und nicht 5844x31x6
2. Wenn du mehrere Zellen mit dem gleichen Wert füllst, solltest du alle diese Zellen in einem Schritt befüllen und nicht per Schleife jede Zelle einzeln.
als ganzes dann:

For lng = 7 To 5850
If Sheets("Urlaubsplanung").Cells(lng, 1) > Sheets("Urlaubsplanung").Cells(3, 9) Then Exit For
For lng1 = 7 To 37
If Sheets("Urlaubsplanung").Cells(lng1, 9) = Sheets("Urlaubsplanung").Cells(lng, 1) Then
Sheets("Urlaubsplanung").Cells(lng1, 10).Resize(, 6) = Sheets("Urlaubsplanung").Cells(lng, i) _
end if
Next
Next
Gruß Daniel
Anzeige
AW: Makro beschleunigen
10.02.2018 08:16:17
Frank
Hallo Daniel!
Es ist nicht meine Art so lange mit einer Antwort auf mich warten zu lassen, aber ich war die letzten Tage verhindert, deshalb erst jetzt. Recht herzlichen Dank, du hast mir sehr geholfen. Jetzt bin ich zufrieden und kann auch andere Dateien, Dank deiner Hilfe beschleunigen.
Lieben Gruß Frank H.
Ein schönes WE wünsche ich.
AW: Makro beschleunigen
10.02.2018 16:14:26
Gerd
Moin Frank!
Sub a()
Dim lng As Long, lng1 As Long, sp As Long
Dim Check As Variant
Dim Pruefe1 As Variant, Pruefe2 As Variant, Schreibe As Variant
With Sheets("Urlaubsplanung")
Check = .Cells(3, 9).Value
Pruefe1 = .Range(.Cells(7, 1), .Cells(5850, 8))
Pruefe2 = .Range(.Cells(7, 9), .Cells(37, 9))
Schreibe = .Range(.Cells(7, 10), .Cells(37, 15))
For lng = 1 To 5844
If Pruefe1(lng, 1) > Check Then Exit For
For lng1 = 1 To 31
If Pruefe2(lng1, 1) = Pruefe1(lng, 1) Then
For sp = 1 To 6
Schreibe(lng1, sp) = Pruefe1(lng, sp + 1)
Next
End If
Next
Next
.Range(.Cells(7, 10), .Cells(37, 15)) = Schreibe
End With
End Sub

Gruß Gerd
Anzeige
AW: Makro beschleunigen
10.02.2018 17:20:09
Frank
Hallo Gerd!
Das ist natürlich der I Punkt. Spitze! Funzt als bestens, herzlichen Dank und noch ein schönes WE.
Gruß Frank H.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige