VBA code voor macro verwijderen lege cellen

[jwruitenberg]

In één van de oude onderwerpen kwam ik de volgende code tegen:

Sub tst()
With Sheets("Blad1") ' vul hier de juiste bladnaam in
    For i = .UsedRange.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(.Rows(i)) = 0 Then
            .Rows(i).EntireRow.Delete
        End If
    Next
End With
End Sub

Nu wil ik echter dat er maar een deel van de lege cellen wordt verwijderd in een bepaald gebied. Dus ik heb het gebied:

C3:K50

En dan wil ik als bijvoorbeeld C5:K5 volledig leeg is dat deze cellen worden verwijderd en de inhoud van de cellen eronder naar boven schuiven. Welke code heb ik dan nodig voor VBA?

 

[cow18]

Sub tst()
     Dim iC
     With Sheets("Blad1").Range("C3:K50") 'aanpassen van blad en desnoods bereik
          iC = .Columns.Count
          For i = .Rows.Count To 1 Step -1
               If WorksheetFunction.CountA(.Cells(i, 1).Resize(, iC)) = 0 Then .Cells(i, 1).Resize(, iC).Delete Shift:=xlUp
          Next
     End With
End Sub

 

[snb]

Sub M_snb()
   For Each it In Range("C3:K50").Rows
     If Application.CountA(it) = 0 Then it.Value = "=1/0"
   Next

   Range("C3:K50").SpecialCells(-4123, 16).Delete -4162
End Sub

 

[jwruitenberg]

Heel hartelijk bedankt! De cellen worden dan inderdaad verwijderd, alleen zit ik met een ander probleem vervolgens:

Ik heb in de A- en B-kolom met een verwijzing:

=ALS($C$4="";"";VANDAAG())

Als de cellen nu verdwijnen dan komt in een deel van de cellen #VERW! te staan. Is daar nog wat aan te doen in de code?

Ten tweede heb ik een specifieke opmaak in de cellen die ik NIET weg wil hebben. Onder de cellen C50 - K50 heb ik andere opmaak en die wordt dan meegenomen tot onder de laatste cellen met tekst. Kan het ook dat wel de tekst wordt opgeschoven naar boven, maar dat de opmaak hetzelfde blijft?

Het is nogal specifiek, maar als iemand het zou weten dan zou dat heel fijn zijn! Hartelijk bedankt voor de codes hierboven, ik begrijp die nu ook en kan die wel toepassen in andere situaties!

 

[cow18]

zoiets dan ?
26 kolommen verder, dat wordt dus kolom AC wordt tijdelijk gebruikt als hulpkolom, ik hoop dat je die niet in gebruik hebt.

Sub tst()
     Dim iRij1, iRij2, iA
     Set c0 = Sheets("Blad1").Range("C3:K50")     'aanpassen van blad en desnoods bereik
     iRij1 = c0.Row                          '1e rij van dat bereik
     iRij2 = c0.Row + c0.Rows.Count - 1      'laatste rij van dat bereik

     With c0
          With .Offset(, 26).Resize(, 1)     '26 kolommen verder een kolom als hulpkolom gebruiken,  BEN JE ZEKER DAT DIE NIET GEBRUIKT IS ??????????
               .FormulaR1C1 = "=IF(OR(ROW()<=4,COUNTA(RC[-26]:RC[-18])>0),"""",1)"     'markeer met een 1, de rijen na rij 4 die helemaal legg zijn tusen C en
               .Value = .Value               'formule door zijn waarden vervangen
               If WorksheetFunction.CountA(.Offset(0)) > 0 Then     'test of er 1-tjes staan in dat bereik (=er zijn lege rijen)
                    Set c1 = .SpecialCells(xlConstants)     'alle 1-tjes in die hulpkolom
                    For iA = c1.Areas.Count To 1 Step -1     'die aflopen in aaneensluitende blokken van beneden naar boven
                         Set c = c1.Areas(iA)     'zo'n blok 1-tjes in de hulpkolom
                         i = c.Row + c.Rows.Count - 1     'laatste rij van dat blok
                         If i < iRij2 Then   'laatste rij van dat blok <> laatste rij van ons bereik
                              'Debug.Print c.Address, i, iRij2, c0.Offset(i + 1 - iRij1).Resize(iRij2 - i, c0.Columns.Count).Address, c0.Cells(c.Row - iRij1 + 1, 1).Address
                              c0.Offset(i + 1 - iRij1).Resize(iRij2 - i, c0.Columns.Count).Cut c0.Cells(c.Row - iRij1 + 1, 1)     'blok na deze rij 1-tjes tot het einde in het c0-bereik knippen en plakken
                         End If
                    Next
               End If
               .ClearContents                'hulpkolom wissen
          End With
     End With
End Sub

 

[snb]

Je zoekt een oplossing voor een onjuiste struktuur van het werkblad.
Verbeter de struktuur en je 'probleem' verdampt.
Ik vind het nogal wat dat je geen voorbeeldbestand meestuurt.

 

[jwruitenberg]

Ah ik wist niet dat dat de bedoeling was, dus bij dezen stuur ik een voorbeeldbestand. Ik heb geen idee wat ik in de structuur niet goed doe, dus hoor graag hoe ik dat op kan lossen.

 

[snb]

Gebruik een reguliere tabelstruktuur
Met de volgende kolomkoppen

Datum

Leerling

Klas

Collega

Reden

Dag

In een tabel verwijder je nooit gegevens, maar zorg je dat afgehandelde regels als afgehandeld gemarkeerd worden (bijv. het vak 'dag' leegmaken).
De kolom nr. lijkt me overbodig.
In een tabel gebruik je het filter om lopende zaken te tonen.
In de kolom komt 1 t/m 5 (of een alternatief ) voor de weekdag (ma - vr) te staan.
Het is niet duidelijk wat er in het gebied na regel 50 komt te staan.

 

[cow18]

Zoiets

Edit : ik had ongeveer dezelfde gedachtengang als SNB, gek nietwaar ?
Het 2e deel van de macro, om weer aan te vullen tot rij 50, dat leek me ook een beetje "TE"

 

[jwruitenberg]

Heel hartelijk bedankt! De tips helpen mij zeker en het voorbeeldbestand is ook helpend!
Ik heb nog één vraag: ik zie in het voorbeeldbestand dat de regels onder de dagen dezelfde opmaak houden, alleen de andere niet. Wat hebt u daaraan veranderd? En is het mogelijk dat ook de regels onder de kolomkoppen Leerling, Klas, Collega en Reden de opmaak zo houden? Ik zie een klein groen hoekje rechts onderin, die zorgt er volgens mij voor dat de opmaak hetzelfde blijft, klopt dat?

Ik doel op het volgende