Zeilen ausblenden geht langsam

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

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

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

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)

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread