Code und Laufzeit verkürzen

Forumthread: Code und Laufzeit verkürzen

Heinz

Hallo Leute
Habe in unteren Code der mir Zeilen mit "0" in Zeile "A" ausblendet.
Funktioniert auch,aber nur braucht es ca.1 Minute
Könnte mann dies etwas schneller machen ?
Danke & Gruß
Heinz

Option Explicit
Sub Nullwerte_ausblenden()
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Jänner").Unprotect
Sheets("Februar").Unprotect
Sheets("März").Unprotect
Sheets("April").Unprotect
Sheets("Mai").Unprotect
Sheets("Juni").Unprotect
Sheets("Juli").Unprotect
Sheets("August").Unprotect
Sheets("September").Unprotect
Sheets("Oktober").Unprotect
Sheets("November").Unprotect
Sheets("Dezember").Unprotect
Sheets("Urlaub").Unprotect
Sheets("Einbringt.").Unprotect
Sheets("Üst").Unprotect
Sheets("and. Abwesenh.").Unprotect
Sheets("bezahlt frei").Unprotect
Sheets("Formel").Unprotect
Sheets("Jänner").Activate
Dim i
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Februar").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("März").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("April").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Mai").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Juni").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Juli").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("August").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("September").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Oktober").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("November").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Dezember").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Urlaub").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Einbringt.").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Üst").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("and. Abwesenh.").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("bezahlt frei").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Formel").Activate
For i = 3 To 154
If Cells(i, 1) = 0 Then
Rows(i).Hidden = True
End If
Next
Sheets("Jänner").Protect
Sheets("Februar").Protect
Sheets("März").Protect
Sheets("April").Protect
Sheets("Mai").Protect
Sheets("Juni").Protect
Sheets("Juli").Protect
Sheets("August").Protect
Sheets("September").Protect
Sheets("Oktober").Protect
Sheets("November").Protect
Sheets("Dezember").Protect
Sheets("Urlaub").Protect
Sheets("Einbringt.").Protect
Sheets("Üst").Protect
Sheets("and. Abwesenh.").Protect
Sheets("bezahlt frei").Protect
Sheets("Formel").Protect
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Code und Laufzeit verkürzen

15.09.2010 20:45:30

Beverly

Hi Heinz,
es wäre wahrscheinlich günstiger, in einer Schleife über alle Tabellenblätter zu laufen (wenn es nicht alle sein sollen, kann man dabei auch welche auslassen), dabei den Schutz aufheben und dann in einer Schleife über die Zeilen laufen und anschließend den Schutz wieder setzen.

AW: Code und Laufzeit verkürzen

15.09.2010 21:18:33

Gerd

Hallo Heinz!

Sub Nullwerte_ausblenden()
Dim vntBlaetter As Variant, intIndex As Integer, i As Long, objWorksheet As Worksheet
With Application
.Calculation = xlCalculationManual: .EnableEvents = False: .ScreenUpdating = False
End With
vntBlaetter = Array("Tabelle1", "Tabelle2", "Tabelle3") 'ANPASSEN/ERGÄNZEN  !!!!
For intIndex = 0 To UBound(vntBlaetter)
Set objWorksheet = ThisWorkbook.Worksheets(vntBlaetter(intIndex))
With objWorksheet
.Unprotect
For i = 3 To 154
.Rows(i).Hidden = .Cells(i, 1) = 0
Next
.Protect
End With
Next intIndex
With Application
.Calculation = xlCalculationAutomatic: .EnableEvents = True: .ScreenUpdating = True
End With
End Sub

Gruß Gerd

AW: Code und Laufzeit verkürzen

15.09.2010 21:58:06

Daniel

Hi
mal davon ausgehend, daß die Tabellenblätter lückenlos hintereinander stehen, "Jänner" das erste Taqbellenblatt ist und der Autofilter nicht schon für was anderes verwendet wird:

Sub test()
Dim Ber as long
Dim i As Long
Ber = Application.Calculation
Application.Calculation = xlCalculationManual
For i = 1 To 18
With Sheets(i)
.Unprotect
.Range("A2:A154").AutoFilter Field:=1, Criteria1:="0", visibledropdown:=False
.Protect
End With
Next
End Sub
application.Calculation = Ber

gruß, Daniel

AW: Code und Laufzeit verkürzen

16.09.2010 09:13:30

JogyB

Hallo Heinz,

Sub NullWerteAusblenden()
Dim mySheets As Sheets
Dim myWsh As Worksheet
Dim hideRng As Range
Dim i As Long
Application.ScreenUpdating = False
Set mySheets = Sheets(Array("Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", _
"August", "September", "Oktober", "November", "Dezember", "Üst", "and. Abwesenh.", _
"bezahlt frei", "Formel"))
For Each myWsh In mySheets
With myWsh
For i = 3 To 153
If .Cells(i, 1) = 0 Then
If hideRng Is Nothing Then
Set hideRng = .Cells(i, 1)
Else
Set hideRng = Union(hideRng, .Cells(i, 1))
End If
End If
Next
.Unprotect
.Rows("3:154").Hidden = False
hideRng.EntireRow.Hidden = True
Set hideRng = Nothing
.Protect
End With
Next
Application.ScreenUpdating = True
End Sub

Läuft bei mir ca. 0,25s.
Gruß, Jogy

kleine Korrektur...

16.09.2010 13:17:15

JogyB

Hallo Heinz,
da war ein kleiner Fehler drin, es muss vor dem Verstecken noch geprüft werden, ob es überhaupt was zu verstecken gibt (ergibt sonst einen Fehler).

Sub NullWerteAusblenden()
Dim mySheets As Sheets
Dim myWsh As Worksheet
Dim hideRng As Range
Dim i As Long
Application.ScreenUpdating = False
Set mySheets = Sheets(Array("Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", _
"August", "September", "Oktober", "November", "Dezember", "Üst", "and. Abwesenh.", _
"bezahlt frei", "Formel"))
For Each myWsh In mySheets
With myWsh
For i = 3 To 153
If .Cells(i, 1) = 0 Then
If hideRng Is Nothing Then
Set hideRng = .Cells(i, 1)
Else
Set hideRng = Union(hideRng, .Cells(i, 1))
End If
End If
Next
.Unprotect
.Rows("3:154").Hidden = False
If Not hideRng Is Nothing Then
hideRng.EntireRow.Hidden = True
Set hideRng = Nothing
End If
.Protect
End With
Next
Application.ScreenUpdating = True
End Sub

Gruß, Jogy

AW: DANKE an Beverly, Gerd L,Daniel & JogyB

16.09.2010 15:12:11

Heinz

Hallo Beverly, Gerd L,Daniel & JogyB
Recht herzlichen Dank für Eure Großartige Hilfe.
Habe mich für den Code von JogyB entschieden.
Grund: Kürzere Laufzeit:

Läuft bei mir ca. 0,25s.

Finde ich bei mir nicht so.Dauer ca.20 Sekunden. Aber gegen vorher, viel kürzerer Code & Laufzeit
Nochmals recht herzlichen Dank an alle Helfer.
Gruß
Heinz

AW: DANKE an Beverly, Gerd L,Daniel & JogyB

16.09.2010 17:21:37

JogyB

Hallo Heinz,
ich hab's gerade nochmal getestet und bin bei mehreren geöffneten Mappen bei ca. 1s (keine Ahnung, warum es füher schneller ging). Schalt mal die Automatische Berechnung während des Makros aus, durch das Verstecken wird nämlich jedes Mal eine Neuberechnung ausgelöst.

Sub NullWerteAusblenden()
Dim mySheets As Sheets
Dim myWsh As Worksheet
Dim hideRng As Range
Dim i As Long
Dim tempCalc As Integer
' Alte Berechnungsoption zwischenspeichern
tempCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set mySheets = Sheets(Array("Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", _
"August", "September", "Oktober", "November", "Dezember", "Üst", "and. Abwesenh.", _
"bezahlt frei", "Formel"))
For Each myWsh In mySheets
With myWsh
For i = 3 To 153
If .Cells(i, 1) = 0 Then
If hideRng Is Nothing Then
Set hideRng = .Cells(i, 1)
Else
Set hideRng = Union(hideRng, .Cells(i, 1))
End If
End If
Next
.Unprotect
.Rows("3:154").Hidden = False
If Not hideRng Is Nothing Then
hideRng.EntireRow.Hidden = True
Set hideRng = Nothing
End If
.Protect
End With
Next
Application.ScreenUpdating = True
Application.Calculation = tempCalc
End Sub

Gruß, Jogy

AW: DANKE an Beverly, Gerd L,Daniel & JogyB

16.09.2010 18:50:34

Heinz

Hallo Jogy
Die Sheets mit den "0" ausblenden sind nicht versteckt. Nur andere Sheets.
Danke & Gruß
Heinz

Beliebteste Forumthreads (12 Monate)

Forumthread: Code und Laufzeit verkürzen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread