Makro: Zu langsam/Blattschutz-Problem
07.11.2006 12:45:22
Düppi
ich habe zwei Probleme mit dem unten aufgeführten Makro. Generell läuft es - der Code stimmt also. Nur führe ich rund 5000 Prüfungen in den For-Schleifen durch. Dies kostet Zeit, bald möchte ich die Zahl der Schleifen von zwei auf sechs erhöhen. Da hilft auch das nette Sub "MehrTempo" nicht viel.
Frage 1: Wie kann ich die Berechnung beschleunigen?
Die Sheets, mit denen ich arbeite, heißen "Ausgaben" und "Guetersloh". In "Ausgaben" werden die Spalten mit den Werten für GTL, WDB und WAR durchsucht und miteinander verglichen. In Guetersloh werden die gefundenen Warte (ganze Zahlen) eingetragen.
Frage 2: Das Sheet "Guetersloh" ist geschützt, die Zellen, in die besagte Zahlen eingetragen sind, gesperrt - logisch, ich will sie ja händisch nicht verändern. Da streikt das Makro. Was kann ich hier tun, fragt Düppi und freut sich zumindest über eine Teillösung beider Probleme!
Private Sub Worksheet_Activate()
Dim lGTL As Integer
Dim lWDB As Integer
Dim lWAR As Integer
MehrTempo (True)
Worksheets("Guetersloh").Range("K5:O52").ClearContents
For lGTL = 5 To 52
For lWDB = 1 To 52
If Sheets("Ausgaben").Range("B" & lGTL).Value = Sheets("Ausgaben").Range("J" & lWDB).Value Then
Sheets("Guetersloh").Range("K" & lGTL).Value = Sheets("Ausgaben").Range("I" & lWDB).Value
Exit For
End If
Next lWDB
Next lGTL
For lGTL = 5 To 52
For lWAR = 1 To 52
If Sheets("Ausgaben").Range("B" & lGTL).Value = Sheets("Ausgaben").Range("R" & lWAR).Value Then
Sheets("Guetersloh").Range("L" & lGTL).Value = Sheets("Ausgaben").Range("Q" & lWAR)
Exit For
End If
Next lWAR
Next lGTL
MehrTempo (False)
End Sub
Sub MehrTempo(bYesNo As Boolean)
Application.ScreenUpdating = Not (bYesNo)
Application.EnableEvents = Not (bYesNo)
Application.Calculation = IIf(bYesNon, xlCalculationManual, xlCalculationAutomatic)
End Sub