Opgelost Lege cellen verwijderen met behoud van formules

Dit topic is als opgelost gemarkeerd
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
947
Beste Helmijers,

Ik ben op zoek naar een vba-code die vanuit kolom B de lege cellen verwijderd en de formules vanuit de naastliggende kolom (A) met een verwijzing naar kolom B intact laat. Zie voorbeeld

Alvast heel hartelijk dank.

Robert
 

Bijlagen

Code: 
Sub DeleteLegeRijen()
    For r = Cells(Rows.Count, 1).End(xlUp).Row To 6 Step -1
        If Cells(r, 2) = "" Then Rows(r).Delete xlShiftUp
    Next
End Sub
 
Super bedankt voor jouw hulp, alleen is het niet de bedoeling dat de regel wordt verwijderd. Ik heb dit als voorbeeld meegestuurd, vanwege het origineel persoonsgegevens bevat en hier in de praktijk nog meer kolommen in staan die gevuld zijn én niet verwijderd mogen worden. Achteraf had ik hier meer duidelijkheid over moeten verschaffen, mijn verontschuldiging hiervoor.
 
Dan wordt het zoiets:
Code: 
Sub WisRijen()
    lastcolumn = Cells.SpecialCells(xlLastCell).Column
    For r = 6 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(r, 2) = "" Then Range(Cells(r, 2), Cells(r, lastcolumn)).ClearContents
    Next
End Sub
 
Laat het gewenste eindresultaat eens zien.
 
WisRijen doet precies wat je wilt, maar je hebt wisLegeCellenInKolomA aan je knop gehangen.
Wat bedoel je met "mits er geen andere kolommen gevuld zijn"?
Ik zie overigens geen verschil met je voorbeeld uit #1.
 
Maak eens een voorbeeldbestand met een werkblad 'Voor' en een werkblad 'Na' want tot hiertoe
tast iedereen hier in het duister, ik inclusief.
 
Sorry, ik heb er nu extra werkbladen in geplaatst. Vanuit de diverse werkbladen is te zien wat het effect is van de drie codes die ik heb gebruikt. M.n. werkblad 'na' kun je goed zien wat er gebeurt als je geen regels verwijderd.
 

Bijlagen

Leg nou eens uit wat er precies moet gebeuren als de cel in kolom B leeg is, je voorbeeld maakt het er beslist niet duidelijker door.
 
Een werkblad 'Na' laat zien hoe de data er moet uitzien nadat er een code uitgevoerd is.
Jij laat enkel zien wat huidige code doet. (wat we trouwens allemaal al weten)
 
In kolom B van werkblad 'na' staan een aantal lege cellen. Zodra je op de knop drukt blijven deze cellen leeg en zie je dat kolom D dan ook in één keer lege cellen heeft. Het is de bedoeling dat kolom D onaangetast blijft en kolom B de lege cellen worden verwijderd. Bovendien is het de bedoeling dat de formules in kolom A, nadat de code is geactiveerd, intact blijven. Ik hoop zo meer duidelijkheid te hebben verschaft.
 
Misschien begin ik het te begrijpen. Je wilt de lege cellen in kolom B er tussenuit halen waardoor de gevulde cellen in kolom B doorschuiven naar boven?
 
Ja, dat klopt helemaal. Zoals je in mijn eerste bericht hebt kunnen zien werkte dat prima alleen gaf dat weer een conflict met de formules in de eerste kolom. Regels verwijderen lijkt een oplossing, echter in de praktijk gebruik ik meerdere kolommen en dan wordt de inhoud daarvan ook verwijderd, vandaar dat ik later kolom D eraan toegevoegd heb.
 
Code: 
Sub wisLegeCellenInKolomB()
    Set Rng = Range(Range("b6"), Range("b" & Rows.Count).End(xlUp))
    a = Rng.Value
    Rng.Clear
    r = 6
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
            Cells(r, 2) = a(i, 1)
            r = r + 1
        End If
    Next
End Sub
 
Dit ziet er super uit en zal het vanavond implementeren in mijn eigen programma.

Ik heb nog wel even een vraag, zou je, mits je tijd hebt, mij willen uitleggen wat onderstaande code doet?
Code: 
    r = 6
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
            Cells(r, 2) = a(i, 1)
            r = r + 1
        End If

Alvast heel hartelijk dank en ook voor al diegenen die mee hebben geholpen heel hartelijk dank!
 
Daar is het mij te warm voor, ik heb het even aan Chatgpt gevraagd:
Code: 
Sub wisLegeCellenInKolomB()
    ' Define the range Rng starting from cell B6 down to the last non-empty cell in column B
    Set Rng = Range(Range("b6"), Range("b" & Rows.Count).End(xlUp))
  
    ' Store the values from the defined range into a 2D array variable 'a'
    a = Rng.Value

    ' Clear the contents of the original range to prepare for rewriting
    Rng.Clear

    ' Start writing back non-empty values to column B, starting at row 6
    r = 6

    ' Loop through each row in the array (first column of the array)
    For i = 1 To UBound(a)
        ' If the cell value is not empty
        If a(i, 1) <> "" Then
            ' Write the non-empty value back into the worksheet in column B
            Cells(r, 2) = a(i, 1)
            ' Move to the next row
            r = r + 1
        End If
    Next
End Sub

Summary of What This Code Does:​


  • It removes all blank cells from column B, starting at B6, and shifts the non-blank cells up so there are no gaps.
  • This is done by:
    1. Reading all the values into an array.
    2. Clearing the original range.
    3. Writing back only the non-empty values starting from row 6.
 
Dit is echt fantastisch, nogmaals heel erg bedankt en neem maar een lekker koel drankje.
 
Array versie.
Code: 
Sub th()
    Dim Nary As Variant, DataOld
    Dim r As Long, nr As Long
    With Sheets("Ist")
        DataOld = .Range("B6", .Range("B" & .Rows.Count).End(xlUp))
        ReDim Nary(1 To UBound(DataOld), 1 To 1)
        For r = 1 To UBound(DataOld)
            If DataOld(r, 1) <> "" Then
                nr = nr + 1: Nary(nr, 1) = DataOld(r, 1)
            End If
        Next r
        .Range("B6", .Range("B" & .Rows.Count).End(xlUp)).ClearContents
        .Range("B6").Resize(nr, 1).Value = Nary
   End With
End Sub
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan