kolommen en rijen verbergen

[SUVERMO]

Goedemorgen iedereen,

het is weer een tijdje geleden, ik heb weer een vraag.
In het tabblad Inteelt_berekenen is het bereik B17:L2063 groen gevuld. In dit bereik staat een stamboom voor maximum 10 generaties.
In B11 kan een merk geselecteerd worden.

Kan iemand helpen voor het volgende?
Een macro die het volgende doet
starten als de inhoud van C2 of C3 wijzigt
De kolommen B t.e.m. L zichtbaar maken.
De rijen 17 t.e.m. 2063 zichtbaar maken.
Als in de kolommen B, C, D, E, F, G, H ,I ,J , K of L in de rijen 17:2063 geen tekst staat dan deze kolom onzichtbaar maken.
Als in de rijen 17 t.e.m. 2063 in de kolommen B t.e.m. L geen tekst staat dan deze rij onzichtbaar maken.

Ik hoop dat iemand mij kan helpen,

Met vriendelijke groeten
Frans

 

[SUVERMO]

Beste,
ik heb geprobeerd en het lukt
maar werkt zo traag
hoe kan het sneller?

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
For Each r In Range("A17:A2063")
            If r.Value = 0 Then
            r.EntireRow.Hidden = True
            Else
            r.EntireRow.Hidden = False
            End If
            Next r
For Each k In Range("D16:L16")
            If k.Value = 0 Then
            k.EntireColumn.Hidden = True
            Else
            k.EntireColumn.Hidden = False
            End If
            Next k
Application.ScreenUpdating = True


End Sub

 

[SUVERMO]

hiermee gaat het heel snel

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Range("$A$16:$A$2063").AutoFilter Field:=1, Criteria1:=">0"
For Each k In Range("D16:L16")
            If k.Value = 0 Then
            k.EntireColumn.Hidden = True
            Else
            k.EntireColumn.Hidden = False
            End If
            Next k
Application.ScreenUpdating = True
End Sub

 

[HSV]

Of:

For Each k In Range("D16:L16")
  k.EntireColumn.Hidden = k.Value = 0
Next k

 

[JEC.]

Eenmaal verbergen

Sub jec()
 Dim sq, i As Long
 Set sq = Cells(1, 9999)
 
 Application.ScreenUpdating = False
 
 With Range("A16").CurrentRegion
  .AutoFilter 1, ">0"
  .Columns.Hidden = False
   For i = 4 To .Columns.Count
     If .Cells(1, i) = 0 Then Set sq = Union(sq, .Cells(1, i))
   Next
 End With
 
 sq.Columns.Hidden = True
End Sub

 

[SUVERMO]

bedankt HSV en JEC
werkt prima nu

 

[snb]

In Excel ingebouwd"

1-malig

Sub M_zet()
    Blad13.Columns(2).Resize(, 10).Group
End Sub

Sub M_snb()
    Blad13.Outline.ShowLevels , 1
    Blad13.Outline.ShowLevels , 2
End Sub

 

[JEC.]

@snb, ik zie niet hoe deze voldoet aan de vraag

 

[SUVERMO]

@snb, was dit voor iets anders?

 

[cow18]

@Jec, dan kan je in 1 keer een aantal kolommen open of dichtklappen

 

[JEC.]

Dat snap ik, alleen de vraag was om specifieke kolommen én rijen voorwaardelijk te verbergen.