• 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.

Regels verwijderen op blad1 als waarde in kolomA voorkomt in kolomA op blad 2

Status
Niet open voor verdere reacties.
J

jerxjac

Gebruiker
Lid geworden
24 apr 2006
Berichten
21
Ik wil de lijst op blad1 opschonen zodat hier alleen de vervallen codes blijven staan.
Op blad “Niet vervallen” heb ik de “Nr_”-s gezet die niet vervallen zijn. Hier komen de ‘Code’ meerdere malen voor.
Ik kan de lijst op blad “Niet vervallen” opschonen door
Code: 
Sub Opschonen_Code()
'
' Opschonen_Code Macro
'

'
    Range("A1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Niet-Vervallen").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Niet-Vervallen").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A1:A66451"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Niet-Vervallen").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B2").Select
    ActiveSheet.Range("$A$1:$A$66451").RemoveDuplicates Columns:=1, Header:= _
        xlNo
End Sub

Nu wil ik de regels verwijderen op Blad1 waarvan de ‘Code’ op blad "Niet-Vervallen" staan.

Ik hoop dat iemand mij verder kan helpen.
Probeer nog een voorbeeld bestand toe te voegen lukt niet dus hierbij een download link;
http://ge.tt/8pqaeTs1/v/0?c
 
Laatst bewerkt:
Probeer deze eens uit op een kopie van je bestand.
Code: 
Sub delrows()
    sn = Sheets("Niet-Vervallen").Cells(1).CurrentRegion.Offset(1)
    sn2 = Sheets("Blad1").Cells(1).CurrentRegion.Resize(, 4)
        For i = 1 To UBound(sn)
            For ii = 1 To UBound(sn2)
                If sn2(ii, 1) = sn(i, 1) Then sn2(ii, 4) = "x"
            Next
        Next
    With Sheets("Blad1")
        .Cells(1).Resize(UBound(sn2), 4) = sn2
        .Columns(4).SpecialCells(2).EntireRow.Delete
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan