PDA

Vollständige Version anzeigen : Makro ist brutal langsam


OfficeUser321
22.04.2009, 18:42
Hallo VBAler,
ich habe ein Makro, das jedes Sheet einer Datei anwählt, in einer festgelegten Range "#Ref!" durch "Tabelle1" ersetzt, zum nächsten Sheet springt, dort "#Ref!" ersetzt etc, bis alle Sheets durch sind und ich glücklich bin (naja, fast):

Sub ersetzen()
Application.ScreenUpdating = False
Dim wks As Double

sheets(1).Range("A1") = Worksheets.Count
wks = 0
Do Until wks = Worksheets.Count
Worksheets(wks + 1).Activate
raus = "#REF!"
rein = "Tabelle1!"
For Each Cell In Selection
Range("B16:AE100").Select
If Cell.HasFormula = True Then
Cell.Formula = Application.WorksheetFunction.Substitute(Cell.Formula, raus, rein)
End If
Next Cell
wks = wks + 1
Loop

End Sub

Ich habe jetzt zweierlei Problem. Einmal ist das Makro brutal langsam, legt sicherlich für 4 Minuten meinen Rechner lahm, da es 40 Sheets durchsuchen muss. Hat da jemand eine Idee, wie man das performanter gestalten könnte?
Der zweite Knackpunkt ist, dass das Makro nur bis zum vorletzten Sheet funktioniert, im letzten Sheet läuft es vor den Pöller: Anwendungs- oder objektdefinierter Fehler
Das passiert immer im letzten Sheet. Schuld ist diese Zeile:
Cell.Formula = Application.WorksheetFunction.Substitute
Hat jemand eine Idee, damit es funktioniert und ein wenig flotter wird?
Schonmal Danke im Vorraus!

Office User

nicht registriert
22.04.2009, 19:58
Hallo,

zu Deinem ersten Problem (Geschwindigkeit):

Schalte zu Beginn des Makros die Berechnungsmethode auf "manuell" und am Ende wieder auf "automatisch". Das sollte einen erkennbaren Geschwindigkeitszuwachs bringen.

Application.Calculation = xlManual

Application.Calculation = xlAutomatic

Grüße
Klaus

jinx
22.04.2009, 20:11
Moin, OfficeUser,

den Bereich der zu durchlaufenden Zellen einschränken (hier auf die fehlerhaften Formelzellen in den einzelnen Tabellen) - ungetestet:

Sub ersetzen()
Dim wks As Worksheet
Dim rngCell As Range
Dim raus As String
Dim rein As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

On Error GoTo exit_here

For Each wks In Worksheets
raus = "#REF!"
rein = "Tabelle1!"
For Each rngCell In wks.Range("B16:AE100").SpecialCells(xlCellTypeFormulas, 16)
rngCell.Formula = Application.WorksheetFunction.Substitute(rngCell.Formula, raus, rein)
Next rngCell
Next wks

exit_here:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

Fairfax
22.04.2009, 20:25
Das Performance Problem kommt dadurch zustande, dass du nicht 40 mal "Suchen - Ersetzen" machst sondern einmal für jede Zelle in jedem Datenblatt.

Bei dem Bereich wo du angegeben hast sind das 100.000 + Rechenoperationen (bin gerade zu faul es genau auszurechen).

Du kannst im Excel (ohne VBA) einen einen Bereich markieren und da über die Standardfunktion Suchen/Ersetzen alles ersetzen und es geht super schnell.

Den Vorgang tät ich einfach in VBA automatisieren. Hab gerade mal mit dem Makrorecoder was aufgenommen.


Range("E7:I20").Select
Selection.Replace What:="1", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False



Muss man natürlich noch ein bisschen anpassen aber sollte die Geschwindigkeit massiv erhöhen da es so nur 40 Rechenoperationen sind.

Gruß

Fairfax

OfficeUser321
23.04.2009, 08:25
Hallo zusammen,

erstmal Danke für die Antworten. Das Einarbeiten von Application.Calculation = xlManual ist schonmal eine gute Sache. Das kannte ich nicht.
@jinx: Erstmal Danke, leider funktioniert das Ganze nicht. In der Zeile:
For Each rngCell In wks.Range("B16:AE100").SpecialCells(xlCellTypeFormulas, 16)
läuft er mit der Meldung "Keine Zellen gefunden" vor den Baum. Leider erschließt sich mir nicht warum? Eine Idee?
@Fairfax: MIt dem makrorecorder habe ich zu Beginn auch gearbeitet. Das funktioniert allerdings nicht, wenn Du #Ref! ersetzen lassen willst. Excel macht es einfach nicht, warum weiß ich nicht. Google hat mir jedenfalls die Erkenntnis geliefert, dass auch andere das nicht mit dem Recorder hinbekommen haben.

Hat jemand denn noch eine Anregung, warum sich das Makro weigert, das letzte Sheet zu bearbeiten?

Grüße

OfficeUser

jinx
23.04.2009, 08:41
Moin, OfficeUser321,

wahrscheinlich erkennt Excel die Daten nicht als Fehlerwerte - entweder im Vorwege die Anzahl der Zellen durch .Cells.Count feststellen lassen und die Aktion nur starten, wenn die Anzahl größer als 0 ist. Ansonsten den Zusatz 16 weglassen, dann sollten alle Formelzellen in die Auswahl kommen.

Die Fehlermeldung taucht halt immer auf, wenn SpecialCells eine bestimmte Art von Zellen nicht finden kann. Übergehen kann man es wie oben beschrieben durch Zählen oder durch Verwendung von On Error Resume Next, wobei das nur die Meldung übergeht, aber keine Aktion ausführt.

Mich würde ein Ausschnitt Deiner Daten interessieren - ich war bisher der Meinung, man müsse anders an die Umwandlung von Fehlerwerten herangehen...

Wegen der Fehlermeldung auf der letzten Tabelle: Sieh Dir Deine Bedingungen für die Schleife an - auf der letzten Tabelle wird eine nicht vorhandene Tabelle (wks + 1) ausgewählt. Warum habe ich wohl eine "sichere" Schleife vorgestellt mit For Each wks in Worksheets... ?

OfficeUser321
23.04.2009, 09:16
Hi jinx,

ich habe jetzt, wie von Dir angeregt,einfach:
").SpecialCells(xlCellTypeFormulas, 16)
rausgenommen, somit sieht das komplette Ergebnis jetztso aus:
Sub ersetzen1()
Dim wks As Worksheet
Dim rngCell As Range
Dim raus As String
Dim rein As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

'On Error GoTo exit_here

For Each wks In Worksheets
raus = "#REF!"
rein = "Tabelle1!"
For Each rngCell In wks.Range("B16:AE100")
rngCell.Formula = Application.WorksheetFunction.Substitute(rngCell.Formula, raus, rein)
Next rngCell
Next wks


'exit_here:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

Das ganze funktioniert super, als I-Tüpfelchen wird jetzt auch das letzteSheet mitgenommen. Zum Verständnis: Könntest Du mir die Zeile :
SpecialCells(xlCellTypeFormulas, 16) noch erklären und warum die jetzt den Fehler verursacht hat? Danke!

Gruß

OfficeUser

jinx
23.04.2009, 09:30
Moin, OfficeUser321,

die Verwendung von wks.Range("B16:AE100").SpecialCells(xlCellTypeFormulas) würde alle Formelzellen der jeweiligen Tabelle ermitteln und nur diese durchlaufen. Die Einschränkung auf die 16 war eine Begrenzung der Formelzellen auf solche, die eine Fehlermeldung darstellen (wahrscheinlich aber nur diejenigem die den gesamten Ausdruck als Fehler darstellen).

Bei Deinem Makro fehlt meiner Meinung nach die Begrenzung auf Formelzellen bzw. die Prüfung auf Formeln in den Zellen... ;)

OfficeUser321
23.04.2009, 10:23
Hi jinx,

habe deinem Post zufolge wieder:
SpecialCells(xlCellTypeFormulas)
hinzugefügt. Das ganze Makro läuft jetzt in gut 30 Sekunden durch, damit ist mein Auftrag erfüllt ;-)
Vielen Dank!

EarlFred
23.04.2009, 10:47
Hallo OfficeUser321,

@Fairfax: MIt dem makrorecorder habe ich zu Beginn auch gearbeitet. Das funktioniert allerdings nicht, wenn Du #Ref! ersetzen lassen willst. Excel macht es einfach nicht, warum weiß ich nicht. Google hat mir jedenfalls die Erkenntnis geliefert, dass auch andere das nicht mit dem Recorder hinbekommen haben.

Warum geht Suchen&Ersetzen nicht?

Probier mal

Sub RefRaus()
Dim wks As Worksheet
Dim raus As String
Dim rein As String

raus = "#REF!"
rein = "Tabelle1!"

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

For Each wks In Worksheets
wks.Cells.Replace raus, rein
Next wks

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

Grüße
EarlFred

OfficeUser321
23.04.2009, 11:12
Hallo EarlFred,

habe Deinen Code jetzt nicht ausprobiert. Ich meinte folgendes:
Du nimmst einen Suchen&Ersetzen-Vorgang auf:
Range("J25:P42").Select
Selection.Replace What:="#REF!", Replacement:="Tabelle1!", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Dann strickt man das in sein Makro ein und ich gebe Dir Brief und Siegel, dass es nicht funktionieren wird. Warum, keine Ahnung. Wenn man einen "normalen" Formelbestandteil ändern will, kein Problem. #REF! mag er aber nicht. Wieso, keine Ahnung.
Officeuser

EarlFred
23.04.2009, 11:25
Hallo Officeuser,

und ich gebe Dir Brief und Siegel

dann hätte ich beides jetzt gerne per PM ;)

Beim Deutschen Excel muss man freilich #Bezug! durch #Ref! im Code ersetzen, aber gehen tut es - warum allerdings nur bei mir und bei allen anderen nicht, kann ich auch nicht beantworten, vermutlich ist mein Excel kaputt ;)

Aber für den unwahrscheinlichen Fall, dass es bei mir klappen sollte, wovon ich ausgehe, da ich es getestet habe, reicht mir bei rund 70 Tabellen und ca. 900 zu ersetzenden Einträgen pro Blatt rund eine Sekunde für einen gesamten Durchlauf.
OK, aber da es bei Dir bereits ungetestet nicht geht, musst Du mit 30 Sekunden leben. Schade. ;)

Grüße
EarlFred