Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1176to1180
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1176to1180
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code und Laufzeit verkürzen

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

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

Betreff
Benutzer
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige