Makro läuft zu lansam
13.08.2005 18:06:48
mike49
da ich ganz wenig Makrokenntnisse besitze, habe ich mir ein Löschen-Makro zusammengebastelt. Läuft aber sehr langsam.
Desweiteren hätte ich gerne noch was ergänzt:
Nach dem Löschen soll im Bereich G8:G38 die zeilenbezogene Formel geschrieben werden, also:
in G8 =WENN(F8>0;"0:00";"")
in G9 =WENN(F9>0;"0:00";"")
usw. bis
in G38 =WENN(F38>0;"0:00";"")
Das Makro:
Public Loeschen As Boolean
Sub Löschen()
Dim strAntwort As String
strAntwort = MsgBox("Achtung: Das gesamte Tabellenblatt wird zurückgesetzt!", _
vbExclamation + vbOKCancel, "Hinweis")
If strAntwort = vbCancel Then Exit Sub 'Bei "Abbrechen" abbrechen.
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
End With
With ActiveSheet
.Unprotect
Loeschen = True
Range("E8:G38").ClearContents
Loeschen = False
.Protect
End With
strAntwort = MsgBox("Die anderen Tabellenblätter ebenfalls zurücksetzen?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Frage")
If strAntwort = vbYes Then
With Application
.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
.EnableEvents = False 'Ereignissprozeduren deaktivieren.
End With
If ANDERE_TABELLEN = True Then
MsgBox "Alle Monate auf Null gesetzt.", _
vbInformation, "Information"
End If
Range("E8").Select
With Application
.EnableEvents = True 'Ereignissprozeduren wieder aktivieren.
.ScreenUpdating = True 'Bildschirmaktualisierung wieder einschalten.
End With
End If
End Sub
Private Function ANDERE_TABELLEN() As Boolean
Dim sh As Object
For Each sh In ThisWorkbook.Sheets
If sh.Name <> ActiveSheet.Name _
And Len(sh.Name) = 3 Then
If TABELLE_AUF_NULL(sh.Name) = False Then
MsgBox "Fehler bei Tabelle: " & sh.Name, _
vbCritical, "Abbruch"
Exit Function
End If
End If
Next
ANDERE_TABELLEN = True 'Erfolg vermerken.
End Function
Private Function TABELLE_AUF_NULL(strTabelle As String) As Boolean
On Error GoTo Ende 'Fehlerbehandlung übernehmen.
With ThisWorkbook 'Alles auf diese Datei beziehen:
With Sheets(strTabelle) 'Alles auf dieses Tabellenblatt beziehen:
.Unprotect
Loeschen = True
Range("E8:G38").ClearContents
Loeschen = False
.Protect
End With
End With
TABELLE_AUF_NULL = True 'Erfolg vermerken.
Ende:
On Error GoTo 0 'Fehlerbehandlung zurückgeben.
End Function
Würde mich über eine Lösung freuen.
Gruß
mike49