Code inkorten

[rob91]

Ik gebruik onderstaande code om lege regels te verbergen.
Aangezien ik 12 tabellen onder elkaar heb heb geef ik voor iedere tabel deze code in met de bijbehorende regels.
Mijn vraag is : kan het ook korter?

Sheets("Blad1").Select
    BeginRow = 153
    EndRow = 212
    ChkCol = 3
    
    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value = "" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        Else
            Cells(RowCnt, ChkCol).EntireRow.Hidden = False
        End If
    Next RowCnt

 

[Roncancio]

Als je de begin- en eindRow aanpast, ben je volgens mij al klaar.

Met vriendelijke groet,


Roncancio

 

[Ginger]

Rob91, Als het gaat om het verbergen kan je 't per tabel met 1 regel en zonder lus doen...

Sub VerbergRegel()

    Range("C153:C212").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

End Sub

Het 2e deel van je if-structuur heb je niet nodig. Je wilt immers alleen maar verbergen, dus dan is de 'else' een logisch gevolg en dus overbodig.

Groet, Leo

 

[Ginger]

misschien nog wel mooier... Samen met een array en een lus (= 1 klein stukje code voor alle tabellen)...

Sub VerbergRegel()
Dim varBereiken As Variant
Dim i As Integer

    varBereiken = Array("C153:C212", "C240:C256")
    
    For i = 0 To UBound(varBereiken)
        Range(varBereiken(i)).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    Next i

End Sub

(zelf even de juiste bereiken aangeven in de array!)

Groet, Leo

P.s. En zo zit ik me te bedenken dat de lus en de array niet nodig zijn als je al je bereiken gewoon in het Range-object stopt! = nog korter!!!

        Range("C153:C212", "C240:C256").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

 

[rob91]

Ginger,

Bedankt :thumb: voor het (vele) meedenken.
Ik ga dit weekend je oplossing uitproberen.
In ieder geval alvast voor zover bedankt!!

Rob

 

[rob91]

Hallo Leo,

Je laatste code toegepast maar geeft een foutmelding.

Ook geprobeerd met je code met array maar geeft hetzelfde resultaat

Kunnen er maar beperkt aantal bereiken opgegeven worden ?

 

[Ginger]

Rob91, Plaats ff je 'test' als bijlage. Dan kan ik kijken waar het mis loopt.

Groet, Leo

 

[rob91]

Hallo Leo,

Hier als bijlage een testbestand met de makro, dan kan je even zien waar het fout gaat.

Rob

 

[Warme bakkertje]

Rob, verwijder alle ' " ' tussen de bereiken. Enkel aan het begin en aan het einde van alle bereiken de ' " ' plaatsen.
vb

Range("C22:C81,C87:C146,C153:C212,C218:C277,C283:C342,C348:C407,C413:C472,C478:C537,C543:C602,C608:C667,C673:C732,C738:C797,C803:C862").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

Mvg

Rudi

 

[rob91]

Ook met deze nieuwe aanwijzing lukt het niet.
Nu krijg ik de melding: er zijn geen cellen gevonden.

Rob

 

[Warme bakkertje]

Rob, omdat er geen enkele cel leeg is, want ze staan vol formules volgens jouw voorbeeldbestand.

Mvg

Rudi

 

[Warme bakkertje]

rob, een mogelijkheid is om ipv een lege cel weer te geven bij geen resultaat ("") een 0 weer te geven. Dus in de zin van

=ALS('H:\Verlofkaarten\[Verlofoverzicht 2009 versie2.1.xls]Blad4'!C104="";[COLOR="Red"]0[/COLOR];'H:\Verlofkaarten\[Verlofoverzicht 2009 versie2.1.xls]Blad4'!C104)

Gebruik daarna onderstaande macro om alle rijen met waarde 0 te verbergen

Sub VerbergNulRijen()
    Dim a As Range, c As Range, s As String
    s = "C22:C81,C87:C146,C153:C212" 'de bereiken die moeten gecontroleerd worden
    Application.ScreenUpdating = False
        For Each a In Range(s)
            For Each c In a
                c.EntireRow.Hidden = (c.Value = 0)
            Next c
        Next a
    Application.ScreenUpdating = True
End Sub

Mvg

Rudi

 

[rob91]

Rudi,

Ik krijg het om een of andere reden niet werkend; makro blijft steken.
Nu heb ik het toch maar per tabel benoemd en werkt het als is het als code niet fraai.
Ik ga eerst mij overige probleme proberen op te lossen en ga daarna nog wel eens kijken
of het te verbeteren is.

In ieder geval bedankt voor het meedenken :thumb:

Rob

 

[Warme bakkertje]

Rob, volgende doet het wel

Sub VerbergNulRijen()
    Dim a As Range, c As Variant, s As String
    s = "C22:C81,C87:C146,C153:C212" 'de bereiken die moeten gecontroleerd worden
    Application.ScreenUpdating = False
        For Each a In Range(s)
            For Each c In a
                c.EntireRow.Hidden = (c.Value = 0)
            Next c
        Next a
    Application.ScreenUpdating = True
End Sub

Mvg

Rudi

 

[Ginger]

Rob, verwijder alle ' " ' tussen de bereiken. Enkel aan het begin en aan het einde van alle bereiken de ' " ' plaatsen.

OEPS... Warme bakkertje, mijn hartelijke dank voor je aanpassing. 'k Lag de afgelopen dagen ziek in bed maar kon 't toch niet laten om af en toe ff uit bed te glippen (hoezo obsessief gedrag???). Ik had dus in de snelheid van het antwoorden gewoon de string overgenomen uit de array die ik had getoond, en dat gaat inderdaad fout!

Groet, Leo

 

[Warme bakkertje]

Effe off-topic, Leo veel beterschap gewenst en graag gedaan

Mvg

Rudi