Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1228to1232
1228to1232
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilen ausblenden geht langsam

Forumthread: Zeilen ausblenden geht langsam

Zeilen ausblenden geht langsam
Gregor
Hallo
Mit folgendem Code blende ich Zeilen aus, wenn Anzahl = 0
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For z = 10 To intLastRow - 1
If WorksheetFunction.CountA(Range(Cells(z, 23), Cells(z, 27))) = 0 Then Rows(z).EntireRow.Hidden = True
Application.StatusBar = "Fortschrittskontrolle: " & intLastRow - z
Next z
Leider läuft das bei über 1000 Zeilen langsam. Gibt es eine schnellere Variante?
Vielen Dank und Gruss
Gregor
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zeilen ausblenden geht langsam
29.09.2011 15:03:59
Rudi
Hallo,
dürfte schneller sein:

Sub aaaa()
Dim lngLastRow As Long, z As Long, rngHide As Range
lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For z = 10 To lngLastRow - 1
If WorksheetFunction.CountA(Range(Cells(z, 23), Cells(z, 27))) = 0 Then
If rngHide Is Nothing Then
Set rngHide = Cells(z, 1)
Else
Set rngHide = Union(rngHide, Cells(z, 1))
End If
End If
Next z
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
End Sub

Gruß
Rudi
Anzeige
AW: Zeilen ausblenden geht langsam
29.09.2011 15:21:49
Tino
Hallo,
kannst mal diesen Code testen.

Sub test()
Dim lngMaxRow&, iCalc%

lngMaxRow = Cells(Rows.Count, 1).End(xlUp).Row - 1
If lngMaxRow < 10 Then Exit Sub

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

    With Range(Cells(10, Columns.Count), Cells(lngMaxRow, Columns.Count))
        .FormulaR1C1 = "=IF(COUNTA(RC23:RC27)=0,TRUE,1)"
        On Error Resume Next
        .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Hidden = True
        .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Hidden = False
        On Error GoTo 0
        .EntireColumn.Delete
    End With

    .EnableEvents = True
    .Calculation = iCalc
    .ScreenUpdating = True
End With
End Sub
Gruß Tino
Anzeige
AW: Zeilen ausblenden geht langsam
29.09.2011 16:25:07
Gregor
Rudi, Tino
Ich werde die beiden Codes morgen testen, komme heute nicht mehr dazu. Feedback folgt.
Vielen Dank
Gregor
AW: Zeilen ausblenden geht langsam
30.09.2011 14:45:45
Gregor
Hoi Rudi, hoi Tino
Vielen Dank klappt bestens.
Den Code von Rudi versuchte ich so abzuändern, dass ich alles ausblenden kann, wenn in den genanntenten Zellen Spalten 18 bis 27 ohne 22) nicht die Werte 1701 bis 1705 vorkommen (Werte werden mit UF bestimmt). Das heisst alles ausblenden ausser Zeilen mit Werte 1701 bis 1705.

Sub Test()
Dim lngLastRow As Long, z As Long, rngHide As Range
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngW As Range
Dim w As Variant
Dim AnfangInput As Integer
Dim EndeInput As Integer
AnfangInput = 1701
EndeInput = 1705
For z = 10 To intLastRow - 1
Set rngW = Union(Range(Cells(z, 18), Cells(z, 21)), Range(Cells(z, 23), Cells(z, 27)))
If WorksheetFunction.CountA(rngW) > 0 Then
For Each w In rngW
If w >= AnfangInput And w

Leider erhalte ich damit nur diejenigen Zeilen wo alle durchsuchten Zellen leer sind. Wie lautet der richtige Code?
Danke und Gruss
Gregor
Anzeige
AW: Zeilen ausblenden geht langsam
30.09.2011 17:10:03
Tino
Hallo,
kannst mal testen.

Sub test()
Dim lngMaxRow&
Dim ArrayR1, ArrayR2, rng As Range
Dim n&, nn&, booFund As Boolean
Dim AnfangInput As Single, EndeInput As Single

AnfangInput = 1701
EndeInput = 1705

lngMaxRow = Cells(Rows.Count, 1).End(xlUp).Row - 1
If lngMaxRow < 10 Then Exit Sub

    With Range(Cells(10, 1), Cells(lngMaxRow, Columns.Count))
        ArrayR1 = .Columns(18).Resize(, 4).Value2
        ArrayR2 = .Columns(23).Resize(, 5).Value2
        
        For n = 1 To Ubound(ArrayR1)
            For nn = 1 To Ubound(ArrayR1, 2)
                If ArrayR1(n, nn) >= AnfangInput Then
                    If ArrayR1(n, nn) <= EndeInput Then booFund = True: Exit For
                End If
            Next nn
            
            If Not booFund Then
                For nn = 1 To Ubound(ArrayR2, 2)
                    If ArrayR2(n, nn) >= AnfangInput Then
                        If ArrayR2(n, nn) <= EndeInput Then booFund = True: Exit For
                    End If
                Next nn
            End If
            
            If booFund Then
                If Not rng Is Nothing Then
                    Set rng = Union(rng, .Rows(n))
                Else
                    Set rng = .Rows(n)
                End If
                booFund = False
            End If
        Next n
        
        Application.ScreenUpdating = False
            .EntireRow.Hidden = True
            If Not rng Is Nothing Then rng.EntireRow.Hidden = False
        Application.ScreenUpdating = True
    End With
End Sub
Gruß Tino
Anzeige
AW: Zeilen ausblenden geht langsam
30.09.2011 19:25:41
Rudi
Hallo,
sollte so gehen.

Sub Test()
Dim lngLastRow As Long, z As Long, rngHide As Range
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim rngW As Range
Dim AnfangInput As Integer
Dim EndeInput As Integer
AnfangInput = 1701
EndeInput = 1705
For z = 10 To intLastRow - 1
Set rngW = Union(Range(Cells(z, 18), Cells(z, 21)), Range(Cells(z, 23), Cells(z, 27)))
If WorksheetFunction.CountA(rngW) > 0 Then
If Application.Min(rngW) >= AnfangInput And Application.Max(rngW)

Gruß
Rudi
Anzeige
AW: Zeilen ausblenden geht langsam
01.10.2011 00:00:34
Gregor
Rudi, Tino
Vielen Dank für eure wertvolle Hilfe. Ich werde beide testen und und in meinen Code einbauen.
Schönes Wochenende
Gregor
;

Beliebteste Forumthreads (12 Monate)

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