VBA: Vis/skjul rækker

Public Sub skjul()
    If Rows(2 & ":" & 224).EntireRow.Hidden Then
        Rows(2 & ":" & 224).EntireRow.Hidden = False
    Else
        If Len(Range("A2:A224").Text) = 0 Then
            Rows(2 & ":" & 224).EntireRow.Hidden = True
        End If
    End If
End Sub

Den skal kun tjekke på værdien i kolonne A.
Hvis f.eks. celle B4 er udfyldt skal række 4 alligevel skjules, hvis A4 er blank.

Det er hver enkelt række i området 2:224, som skal tjekkes.

Public Sub skjul()
    Dim SK As Boolean, I As Integer
    SK = True
    Application.ScreenUpdating = False
    For I = 2 To 224
        If Rows(I).EntireRow.Hidden Then
            Rows(I).EntireRow.Hidden = False
            SK = False
        End If
    Next
    If SK Then
        For I = 2 To 224
            If Cells(I, 1) = "" Then
                Rows(I).EntireRow.Hidden = True
            End If
        Next
    End If
    Application.ScreenUpdating = True
End Sub

Tak, det ser ud til at virke, men den kører i hele 20 sekunder.
Kan det virkelig passe?

det er ikke hurtigt at skjule rækker, her er måske en forbedring

Public Sub skjul()
    Dim SK As Boolean, I As Integer, Data As Variant
    SK = True
    Data = Range("A1:A224")
    Application.ScreenUpdating = False
    For I = 2 To 224
        If Rows(I).EntireRow.Hidden Then
            Rows(I).EntireRow.Hidden = False
            SK = False
        End If
    Next
    If SK Then
        For I = 2 To 224
            If Data(I, 1) = Empty Then
                Rows(I).EntireRow.Hidden = True
            End If
        Next
    End If
    Application.ScreenUpdating = True
End Sub

det tager ca 1 sek. her

har du formler på arket, så slår vi lige beregninger fra

Public Sub skjul()
    Dim SK As Boolean, I As Integer, Data As Variant
    SK = True
    Data = Range("A1:A224")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For I = 2 To 224
        If Rows(I).EntireRow.Hidden Then
            Rows(I).EntireRow.Hidden = False
            SK = False
        End If
    Next
    If SK Then
        For I = 2 To 224
            If Data(I, 1) = Empty Then
                Rows(I).EntireRow.Hidden = True
            End If
        Next
    End If
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

prøv:

Sub Skjul()
Range("a2:a224").SpecialCells(xlCellTypeBlanks).Cells.Select
If Selection.EntireRow.Hidden = True Then Selection.EntireRow.Hidden = False Else Selection.EntireRow.Hidden = True
Cells(1, 1).Select
End Sub

Ja, der er nogle tunge formler imellem.
Men den sidste var god - ca. 3 sek.

Smid et svar og tak for hjælpen.

Hvis koden nu skal køre på ark2 til ark10, hvordan vil koden så se ud?

Ups, det var jo exelent. Smid også du et svar, så kan I dele.

samme kode blot skal den ind i ThisWorkbook

og dog lad os lige tænke :-)

alm. modul

Sub xskjul()
Dim t
Application.ScreenUpdating = False
For t = 2 To 10
Sheets(t).Select
Range("a2:a224").SpecialCells(xlCellTypeBlanks).Cells.Select
If Selection.EntireRow.Hidden = True Then Selection.EntireRow.Hidden = False Else Selection.EntireRow.Hidden = True
Cells(1, 1).Select
Next
Cells(1, 1).Select
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

af en eller anden grund har SpecialCells(xlCellTypeBlanks)
problemer med helt nye ark.
kan løses med at indtaste et fx. x i en celle og så slette det igen
et sted neden for 'hide området'
ikke sikkert det har betydning i dit eks.