Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
816to820
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
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro: Zu langsam/Blattschutz-Problem

Makro: Zu langsam/Blattschutz-Problem
07.11.2006 12:45:22
Düppi
Liebe Excel-Profis,
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro: Zu langsam/Blattschutz-Problem
07.11.2006 13:27:12
ChrisL
Hallo
Ziel wäre mindestens einen Teil der Schleifen (die Schleifen zum Suchen) zu vermeiden. Ich gehe mal davon aus, dass die Aufgabe ohne VBA mit der Tabellenfunktion SVERWEIS (Suchkriterium, Suchmatrix) lösbar wäre. Diese Tabellenfunktion oder z.B. auch VERGLEICH (Match) lässt sich auch in VBA verwenden:
WorksheetFunction.VLookup(...)
Gruss
Chris
AW: Makro: Zu langsam/Blattschutz-Problem
07.11.2006 13:28:23
ChrisL
Hallo
Frage 2: Blattschutz temporär aufheben z.B.
Sheets(...).Unprotect
' Dein Makro
Sheets(...).Protect
Gruss
Chris
AW: Makro: Zu langsam/Blattschutz-Problem
07.11.2006 14:29:38
fcs
Hallo Düppi,
Blattschutz hats du ja schon erklärt bekommen.
Beschleunigen:
1. Verwendung von Cells(Zeile,Spalte) statt Range("B" & Zeile)
Bringt ca. 20%
2. Deklaration von Bereichen deren Werte in Schleifen geprüft werden statt Zelle für Zelle im Blatt abzuarbeiten.
Bringt geschätze 50%
Schaut so aus:

Private Sub Worksheet_Activate()
Dim lGTL   As Integer
Dim lWDB   As Integer
Dim lWAR  As Integer
Dim Ausgaben1 As Range, Ausgaben2 As Range
MehrTempo (True)
Worksheets("Guetersloh").Unprotect
Worksheets("Guetersloh").Range("K5:O52").ClearContents
Set Ausgaben1 = Sheets("Ausgaben").Range("B5:B52")
Set Ausgaben2 = Sheets("Ausgaben").Range("J1:J52")
For lGTL = 1 To Ausgaben1.Rows.Count
For lWDB = 1 To Ausgaben2.Rows.Count
If Ausgaben1(lGTL, 1) = Ausgaben2(lWDB, 1) Then
Sheets("Guetersloh").Cells(lGTL + 4, "K").Value = Sheets("Ausgaben").Cells(lWDB, "I").Value
Exit For
End If
Next lWDB
Next lGTL
Set Ausgaben1 = Sheets("Ausgaben").Range("B5:B52")
Set Ausgaben2 = Sheets("Ausgaben").Range("R1:R52")
For lGTL = 1 To Ausgaben1.Rows.Count
For lWAR = 1 To Ausgaben2.Rows.Count
If Ausgaben1(lGTL, 1) = Ausgaben2(lWAR, 1) Then
Sheets("Guetersloh").Cells(lGTL + 4, "L").Value = Sheets("Ausgaben").Cells(lWAR, "Q")
Exit For
End If
Next lWAR
Next lGTL
Worksheets("Guetersloh").Protect
MehrTempo (False)
Range("A1").Select
End Sub

3. Verwenden der Suchen-Funktion mit deklarierten Bereichen
Läuft am schnellsten

Private Sub Worksheet_Activate()
Dim lGTL   As Integer
Dim lWDB   As Integer
Dim lWAR  As Integer
Dim Ausgaben1 As Range, Ausgaben2 As Range, Gefunden As Range
MehrTempo (True)
Worksheets("Guetersloh").Unprotect
Worksheets("Guetersloh").Range("K5:O52").ClearContents
Set Ausgaben1 = Sheets("Ausgaben").Range("B5:B52")
Set Ausgaben2 = Sheets("Ausgaben").Range("J1:J52")
For lGTL = 1 To Ausgaben1.Rows.Count
Set Gefunden = Ausgaben2.Find(what:=Ausgaben1(lGTL, 1), After:=Ausgaben2(Ausgaben2.Rows.Count, 1), LookIn:=xlValues)
If Not Gefunden Is Nothing Then
Sheets("Guetersloh").Cells(lGTL + 4, "K").Value = Sheets("Ausgaben").Cells(Gefunden.Row, "I").Value
End If
Next lGTL
Set Ausgaben1 = Sheets("Ausgaben").Range("B5:B52")
Set Ausgaben2 = Sheets("Ausgaben").Range("R1:R52")
For lGTL = 1 To Ausgaben1.Rows.Count
Set Gefunden = Ausgaben2.Find(what:=Ausgaben1(lGTL, 1), After:=Ausgaben2(Ausgaben2.Rows.Count, 1), LookIn:=xlValues)
If Not Gefunden Is Nothing Then
Sheets("Guetersloh").Cells(lGTL + 4, "K").Value = Sheets("Ausgaben").Cells(Gefunden.Row, "Q").Value
End If
Next lGTL
Worksheets("Guetersloh").Protect
MehrTempo (False)
Range("A1").Select
End Sub

Gruß
Franz
Anzeige
AW: Makro: Zu langsam
07.11.2006 15:29:12
Düppi
Hallo Franz,
nett von Dir, Dich meines Problems so ausführlich anzunehmen - besten Dank. Zur Lösung: Version 2 läuft soweit. Nur werden im Blatt "Guetersloh", wenn beim Verlgeich "Ausgaben", Spalten B und J keine Übereinstimmung herauskommt, die leeren Zeilen mit der Zahl 4 beschrieben. Sicherlich nur eine Kleinigkeit, die da noch geändert werden müsste. Dürfe ich Dich darum nochmal bitten?
Zur Deiner Lösung 3: Sie führt leider zu gar keinem Ergebnis, wäre aber schön, weil das Makro schnell abgearbeitet wird - eben nur ohne Zahlen auszuspucken!
Dank und Gruß, Düppi!
AW: Makro: Zu langsam
07.11.2006 15:50:35
fcs
Hallo Düppi,
die 4 muss ja irgendwo herkommen. Kann es sein, das in Spalte B und J Zellen ohne Eintrag (leer) sind, diese werden dann natürlich auch als = interpretiert.
Dann müßtes du die If-Zeilen etwa so umbauen:
If Ausgaben1(lGTL, 1) = Ausgaben2(lWDB, 1) Then
in
If Ausgaben1(lGTL, 1) = Ausgaben2(lWDB, 1) And Ausgaben1(lGTL, 1)"" Then
Keine Ahnung warum die Variante mit Find nicht funktioniert. Da bräuchte ich dann mal eine Beispieldatei mit den beiden Tabellenblätten "Ausgaben" und "Guetersloh" (ggf. wichtige Daten löschen oder durch Dummydaten ersetzen.
Gruß
Franz
Anzeige
AW: Makro: Zu langsam
07.11.2006 15:56:51
Düppi
Hallo Franz, das wars - jetzt läufts. Wegen Variante 3 würde ich mich mal noch unter dem Betreff Makro: Zu langsam - für Franz
bei Dir melden, wenns Dir nichts ausmacht!
Bis dahin vielen Dank und alles Gute, Düppi!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige