Selectief kolommen verwijderen

[joost1985]

Geachte bezoekers,

Mijn vraag is als volgt:
Ik heb een hele hoop data in excel, maar tussen sommige data staat een lege cel. Nu wil ik programmeren dat als er een lege cel is de hele kolom verwijderd wordt.

ik zat hieraan te denken maar dit werkt niet:

Sub kolommen()

'in kolom 4 moet de macro beginnen
X = 4

Do while Sheets("blad1").cells(2,X) <> ""
cells(2,X).select
With activecell.entirecolumn.delete

X = X +1

Loop

End sub

Kan iemand me hierbij helpen?

Alvast bedankt.

 

[Warme bakkertje]

Uit de losse pols, zonder voorbeeldbestand

Sub tst()
With Sheets("Blad1")
    For i = 4 To .UsedRange.Columns.Count
        If .Cells(2, i) = "" Then .Cells(2, i).EntireColumn.Delete
    Next
End With
End Sub

 

[MDN111]

Let op: De "kolomenteller" i gaat vanaf 4 omhoog. Veronderstel dat i op 6 staat en je moet die kolom deleten, dan komt de 7de kolom als 6de te staan, maar de teller gaat naar 7. Dus die kolom sla je over. Om dat te vermijden moet de "kolommenteller" starten met een waarde gelijk aan het totaal aantal kolommen en stapsgewijze dalen naar 4.

De opdracht luidt ook dat als er ergens een lege cel staat, de hele kolom moet gedelete worden. Dus per kolom moeten dus ook alle rijen geëvalueerd worden.

Tenslotte, het gebruik van de UsedRange is gevaarlijk. Zie http://www.beyondtechnology.com/geeks012.shtml

Dit alles leidt to de hiernavolgende code:

Option Explicit

Sub test()
Dim nRow, nCol, nRows, nCols
nRows = LastCell(Sheets("Blad 1")).Row
nCols = LastCell(Sheets("Blad 1")).Column
With Sheets("Blad 1")
    For nCol = nCols To 4 Step -1
        For nRow = 1 To nRows
          If .Cells(nRow, nCol) = "" Then
             .Cells(nRow, nCol).EntireColumn.Delete
             Exit For
        End If
        Next
    Next
End With
End Sub

'Onderstaande code is onleent van http://www.beyondtechnology.com/geeks012.shtml.
Function LastCell(ws As Worksheet) As Range
  Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

  On Error Resume Next

  With ws

  ' Find the last real row

    LastRow& = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

  ' Find the last real column

    LastCol% = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column

  End With

' Finally, initialize a Range object variable for
' the last populated row.

  Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function

Grtz,
MDN111.

 

[Warme bakkertje]

@ MDN11
Ik denk niet dat je jouw macro getest hebt want na het draaien is ALLE data gewist. Je hebt wel een punt als je stelt dat het verwijderen van achter naar voor moet gebeuren, net zoals bij rijen van onder naar boven.
Een voorbeeldbestandje van TS zou al veel kunnen ophelderen wat betreft de plaatsing v/d gegevens op het werkblad

 

[MDN111]

@ Warme bakkertje:

Het verbaast me dat bij jou alle data gewist worden!

Ik had m'n macro wel getest, maar misschien zijn er scenario's waarbij het toch niet werkt.
In bijlage het bestandje met de macro. Ik heb twee regels bijgevoegd om de kolom die gaat verwijderd worden te selecteren en te melden. De kolommen 6, 9 en 12 worden verwijderd zoals voorzien, want daarin staan lege cellen (gekleurd).

Grtz,
MDN111.