• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Geselecteerde + naast liggende cellen verwijderen_2

Status
Niet open voor verdere reacties.
J

jansm

Gebruiker
Lid geworden
2 apr 2014
Berichten
421
Hallo,
ik heb op blad1 twee tabelletjes.
Ik gebruik een code (ex VenA) om ALLEEN in het linker tabelletje bepaalde cellen in de 3 kolommen D, E en F te verwijderen. Dit doe ik door bepaalde cellen in kolom D te selecteren en de code te runnen. Nu wil ik graag dat gelijktijdig in dezelfde regel ook de cellen in de 4 kolommen J t/m M verwijderd worden. En laat me dat nu niet lukken! Kan iemand voor mij de code aanpassen? Alvast bedankt!
Bekijk bijlage CellenVerwijderen_1.xlsb


PS de tussenliggende cellen mogen niet verwijderd worden
 
Laatst bewerkt:
Vena zal het niet waarderen dat ik zijn code ver***** :cool:, maar dit werkt volgens mij

Code: 
Sub VenA_2()  'ex VenA
Dim r As Range, cl As Range
     If Selection.Columns.Count = 1 And Selection.Column = 4 Then 'als aantal geselcteerde kolommen=1 en alleen kolom 4 (D) is geselecteerd
        ActiveSheet.Unprotect 'Tabblad beveiligen opheffen
             For Each cl In Selection
                 If r Is Nothing Then
                    Set r = cl.Resize(, 3)
                    Set rr = cl.Offset(, 6).Resize(, 4)
                 Else
                    Set r = Union(r, cl.Resize(, 3))
                    Set rr = Union(rr, cl.Offset(, 6).Resize(, 4))
                 End If
             Next cl
                    If Not r Is Nothing Then r.Delete Shift:=xlUp
                    If Not rr Is Nothing Then rr.Delete Shift:=xlUp
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Tabblad beveiligen
        Else:  MsgBox "SELECTEER ALLEEN CELLEN IN KOLOM A", vbExclamation, "  VERWIJDEREN WORDT GESTOPT "
     End If
End Sub
 
Wie is mijn ex? Wat lukt er niet? Waarom rommelen met beveiligingen als het project nog niet klaar is? Waarom mogen de tussenliggende cellen niet verwijderd worden? Er staat toch niets in?

[Edit]
@SjonR, Jouw berichtje en code heb ik blijkbaar gemist. Van mij mag je alles ver*****beteren?;) En elke bijdrage waardeer ik. Wat werkt dat werkt.:thumb:

[Edit2] Iets eenvoudiger.

Code: 
Sub ExvanVenA()
  Dim r As Range, cl As Range
  If Selection.Columns.Count = 1 And Selection.Column = 4 Then
    For Each cl In Selection
      If r Is Nothing Then Set r = Union(cl.Resize(, 3), cl.Offset(, 5).Resize(, 4)) Else Set r = Union(r, cl.Resize(, 3), cl.Offset(, 5).Resize(, 4))
    Next cl
    If Not r Is Nothing Then r.Delete Shift:=xlUp
  End If
End Sub
 
Laatst bewerkt:
SjonR, bedankt voor je bijdrage. VenA, werkt weer tof. Uiteraard ook bedankt
 
Wie is mijn ex? Wat lukt er niet? Waarom rommelen met beveiligingen als het project nog niet klaar is? Waarom mogen de tussenliggende cellen niet verwijderd worden? Er staat toch niets in?
Klik om te vergroten...
de tabellen die ik hier laat zien zijn uiteraard niet mijn werktabellen. Ik probeer zelf jouw code hieraan aan te passen. Dat lukt me meestal nog net.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan