Office: lange Laufzeit beim Formatieren

Hallo liebe Gemeinde,

habe eine Mappe mit mehreren Tabellenblättern - zurzeit 42
auf 41 Blättern habe ich einen Monat abgebildet welchen ich mit einem Makro formatiere.
Auf dem ersten Blatt stelle ich einen Monat ein und auf den restlichen Blättern wird der Monat erzeugt mit Feiertagen, Samstagen und Sonntagen.
Samstage blende ich aus und an Sonntagen verkleinere ich die Zeilenhöhe.

Nur dauert das fast 2 Minuten bis die Zellen formatiert sind.

Vielleicht hat einer von euch einen Tipp wie ich das Beschleunigen kann.

hier die Passage um welche es sich dreht:
For intI = 2 To ThisWorkbook.Worksheets.Count
Sheets(intI).Select 'Tabellenblätter nacheinander auswählen
On Error Resume Next
For i = 15 To 48
'Samstage Zellenhöhe auf 10
If Weekday(Cells(i, 1), vbMonday) = 6 Then
Rows(i).RowHeight = 10
Else
Rows(i).RowHeight = 20
End If

'Sonntage und leere Zellen ausblenden
If Weekday(Cells(i, 1), vbMonday) = 7 Or Cells(i, 1).Value = "" Then
Rows(i).Hidden = True
Else
Rows(i).Hidden = False
End If
Next i
Next intI

Ist nur ein Auszug aus dem Code.
Im Anhang mal ein verkleinertes Beispiel.

Würde mich über eine Verbesserung freuen.

Danke

Gruß
Dietmar

:)

 

Der Code steht doch im Beitrag, warum muss dann eine makroverseuchte Mappe hochgeladen werden?

Da ich mir deine Mappe daher nicht anschaue, nahm ich eine Testmappe, in der der gezeigte Makroteil nach 0,03125 Sekunden pro Blatt fertig war. Der Code ist nicht optimal, da es Redundanzen gibt, aber offenbar liegt es nicht am Code, wenn es so lange dauert.

Hast du den Code mal im Einzelschritt durchlaufen lassen? Gibt es einen Schritt, der merklich länger dauert als andere? Welcher? Was passiert da noch?

 

Hallo und guten Tag,
erst einmal Danke für deine Antwort.

Verseuchte Datei?
Auf meinem Rechner läuft Kaspersky aktuelle Version und Hitmanpro aktuelle Version - diese fanden keinen Schädling.

Zur Sicherheit lies ich die Datei auf VirSCAN.org - Free Multi-Engine Online Virus Scanner v1.02, Supports 47 AntiVirus Engines! durchlaufen - dort werkeln ca. 40 Scanner - kein Schädling gefunden.

Hänge auch ein paar Bilder von mir an.

Hoffe das ist aus der Welt.


Nun zu meinem Problem.

Ja, ich ließ den Code Schritt für Schritt (schön mit F8) durchlaufen - sieht alles gut aus.
Es läuft nix länger, fühlt sich alles gleich schnell an.

In der Mappe bzw. in den Blättern sind ein paar Formeln vorhanden aber sonst auch nix.

Gruß
Dietmar

 

Hier der komplette code:
Sub SonUndLeerRaus()
'Sonntage und Leere Zellen ausblenden
Dim intI As Integer
Dim i As Integer
Dim letzesAktivesBlatt As String
'Meldungen ausschalten, Bildschirmaktualisierung ausschalten
Call Meldungen_Aus
'alle Blätter einblenden und zur Bearbeitung öffnen
Call Alle_Blaetter_Einblenden_Schutz_auf
'komplette Mappe neu berechnen
Application.CalculateFull
'automat.Berechnung ausschalten
Application.Calculation = xlCalculationManual
'Blatt für Blatt von Zeile 15 bis Zeile 48 formatieren
For intI = 2 To ThisWorkbook.Worksheets.Count
If Sheets(intI).Name = "FO DE 7-5-200-28 NK" Then
GoTo weiter
End If
Sheets(intI).Select 'Tabellenblätter nacheinander auswählen
On Error Resume Next
For i = 15 To 48
'Samstage Zellenhöhe auf 10
If Weekday(Cells(i, 1), vbMonday) = 6 Then
Rows(i).RowHeight = 10
Else
Rows(i).RowHeight = 20
End If

'Sonntage und leere Zellen ausblenden
If Weekday(Cells(i, 1), vbMonday) = 7 Or Cells(i, 1).Value = "" Then
Rows(i).Hidden = True
Else
Rows(i).Hidden = False
End If
Next i
weiter:
Next intI
'Blätter ausblenden und Schutz einschalten
Call Alle_Blaetter_Ausblenden_Schutz_zu
'Meldungen einschalten, Mappenschutz aktivieren und Bildschirmaktualisierung einschalten
Call Meldungen_Ein
'automat.Berechnung einschalten
Application.Calculation = xlCalculationAutomatic
'Letztes aktives Blatt einblenden und Blatt "Start" aktivieren
Call zu_Blatt_springen
Worksheets("Start").Select
End Sub


----------------------------------------
Sub Meldungen_Aus()
'Meldungen ausschalten, Mappenschutz aufheben, Bildschirmaktualisierung ausschalten
Application.DisplayAlerts = False
ActiveWorkbook.Protect Structure:=False, Windows:=False
Application.ScreenUpdating = False
End Sub

Sub Meldungen_Ein()
'Meldungen einschalten, Mappenschutz aktivieren und Bildschirmaktualisierung einschalten
Application.DisplayAlerts = True
ActiveWorkbook.Protect Structure:=True, Windows:=True
Application.ScreenUpdating = True
End Sub

Sub Alle_Blaetter_Einblenden_Schutz_auf()
'alle Blätter bis auf Start einblenden und Blatt-Schutz deaktivieren
For i = 2 To Sheets.Count
Sheets(i).Visible = True
Worksheets(i).Unprotect
Next i
End Sub

Sub Alle_Blaetter_Ausblenden_Schutz_zu()
'alle Blätter bis auf Start ausblenden und Blatt-Schutz aktivieren
For i = 2 To Sheets.Count
Sheets(i).Visible = False
Worksheets(i).Protect
Next i
End Sub

 

Jotti's malware scan
hat auch keinen Schädling gefunden.

;-)
siehe Bild

 

Mappen mit enthaltenen Makros ("makroverseucht") öffne ich nicht. Was deine Virenscanner für eine Meinung haben interessiert mich da herzlich wenig.

Aber vielleicht schaut ein anderer rein, der 'ne Sandbox hat oder dem das egal ist.

 

Ok,
dir noch einen schönen Tag
Gruß

 

Mach ne XLSX draus und lade hoch....

 

hier ein möglicherwiese vergleichbares Thema:
https://www.ms-office-forum.net/foru...d.php?t=367619

Vielleicht kannst du die Lösung umsetzen.

 

Hallo nochmal,

wenn ich alle Formeln aus den Tabellen raus hole läuft es in einem Bruchteil einer Sekunde.
Habe es gerade versucht.

Datei ist als xlsx dran

 

Danke für den Tipp - das bringt mich leider nicht weiter.
Gruß

 

Jetzt, wo Du ein Teil aus #2 selbst auch noch belegen konntest, liegt es nahe, Deinen Code wieder in die Mappe zu schreiben und den Rest aus #2 versuchen umzusetzen.
Dann wärst Du zum jetzigen Zeitpunkt sicher noch einen Schritt weiter.

Schlage vor:

[*]Schreibe das Makro wieder in das File (oder nimm das Original)

[*]Klicke in Sub SonUndLeerRaus()

[*]gehe via F8 in Einzelschritten durch und gib Rückmeldung welche Zeile(n) auffällig lange "rechnen"

 

Hallo Marko,

lies alles Schritt für Schritt per F8 durchlaufen - aber eine merkliche Verzögerung kann ich nicht feststellen, es läuft gleichmäßig. Das prüfen und formatieren der Zeilen scheint seine Zeit zu brauchen.
Wobei ich am Inhalt nix ändere nur Zeilen ausblende, kleiner oder größer mache und einfärbe (was mit bedingter Formatierung gemacht wird).

Wenn du dir den Code anschaust, siehst du da etwas was du anders schreiben würdest?

Gruß
Dietmar

 

Hallo Dietmar,

die Mappe und den Code habe ich mir mal angeschaut und empfehle folgendes:

Durchlaufzeiten:
vorher	13,27344 s
nachher	2,171875 s

 

Hallo Marco,

danke für deinen Hinweis.

Wenn ich nun den Monat ändere dann werden die Tabellen nicht richtig formatiert.

Wenn ich in Zelle B6 in Blatt Fo1 auf 01.05.2020 (beispielhaft) eintrage passen die Zeilen nicht mehr.

Mache ich die beiden Hochkommas aus dem Code wieder raus passt die Formatierung wieder - läuft aber wieder so lange.
1,187 zu 11,257

Mit dem With wks ist richtig gut, darauf bin ich nicht gekommen.

Bastle noch ein wenig weiter.

Nochmal danke für eine Hilfe.

Gruß
Dietmar