Naam niet vinden dan wissen

Status
Niet open voor verdere reacties.

Oude leerling

Gebruiker
Lid geworden
30 aug 2010
Berichten
554
Geacht forum,

Ik heb op blad2 een aantal personen staan met daarachter hun gegevens.

Als nu een naam op dit Blad2 niet meer voorkomt in het ledenbestand op Blad1,
dan wil ik die naam op Blad2 incl. de gegevens via een macro kunnen wissen.

Ik kom daar zelf niet uit.
zie de bijlage

Vriendelijke groet , Jaap Bekijk bijlage Niet vinden dan wissen.xlsx
 
Bv.

Code:
Sub hsv()
Dim sn, arr, gev, i As Long, j As Long, n As Long
 With Sheets("blad2")
   sn = .Cells(12, 1).CurrentRegion
   arr = sn
   For i = 1 To UBound(sn)
     gev = Application.Match(sn(i, 1), Sheets("blad1").Columns(3), 0)
        If Not IsError(gev) Then
           n = n + 1
             For j = 1 To Ubound(sn,2)
               arr(n, j) = sn(i, j)
             Next j
         End If
     Next i
   .Cells(30, 1).Resize(n,ubound(sn,2)) = arr
  End With
End Sub
 
hsv,
Hij haalt inderdaad de naam met bij behorende regel eruit.
Maar plaatst de gegevens dan op regel 30
Het zou zo moeten zijn dat het op dezelfde plaats blijft.
Wel mooi dat het weer aansluitend staat.

Jaap
 
Met de vorige code kon je het controleren Jaap.


Code:
Sub hsv()
Dim sn, arr, gev, i As Long, j As Long, n As Long
 With Sheets("blad2")
   sn = .Cells(12, 1).CurrentRegion
   arr = sn
   For i = 1 To UBound(sn)
     gev = Application.Match(sn(i, 1), Sheets("blad1").Columns(3), 0)
        If Not IsError(gev) Then
           n = n + 1
             For j = 1 To UBound(sn, 2)
               arr(n, j) = sn(i, j)
             Next j
         End If
     Next i
    .Cells(12, 1).CurrentRegion.ClearContents
    .Cells(12, 1).Resize(n, 5) = arr
 End With
End Sub
 
Harry,

Ga eten koken voor me vrouw. (Een dag in de week)
Kom er nog op terug.
Jaap
 
Voor als je uit gekookt bent en jouw vrouw uit gesmikkeld is (mag ik hopen voor haar):d

Zonder lusjes maar wel met wat meer interactie op het blad.
Code:
Sub VenA()
  With Sheets("Blad2")
    .Range("F12:F" & .Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=MATCH(RC[-5],Blad1!C[-3],0)"
    On Error Resume Next
    .Columns(6).SpecialCells(-4123, 16).EntireRow.Delete
    .Columns(6).ClearContents
  End With
End Sub
 
HSV/venA

Het eten was weer gelukt , dus hier ben ik weer

In het voorbeeld bestandje werkte alles goed. mooie oplossingen!
Ik ga er eens voor zitten om ze te doorgronden.

Wat ik echter in dit voorbeeld bestand niet had meegenomen is , dat er in kolom E formules met verwijzingen staan

Dus niet de gehele rij moet gewist worden maar alleen A t/m D.

Is dit nog te realiseren?
 
Laatst bewerkt:
En over welke formules heb je het? Waarom niet direct een representatief bestand? De code van HSV verwijdert geen rijen en is dus het meest makkelijk aan te passen. Zoek in google maar even op 'Resize VBA'
 
Volgens mij is er niets anders aan het laatste bestand dan de eerste Jaap.


Code:
Sub hsv()
Dim sn, arr, gev, i As Long, j As Long, n As Long
 With Sheets("blad2")
   sn = .Cells(12, 1).CurrentRegion
   arr = sn
   For i = 1 To UBound(sn)
     gev = Application.Match(sn(i, 1), Sheets("blad1").Columns(3), 0)
        If Not IsError(gev) Then
           n = n + 1
             For j = 1 To UBound(sn, 2) - 1
               arr(n, j) = sn(i, j)
             Next j
         End If
     Next i
    .Cells(12, 1).CurrentRegion.Resize(, 4).ClearContents
    .Cells(12, 1).Resize(n, 4) = arr
 End With
End Sub
 
Als je steeds blijft veranderen van opzet, zal de code dat ook moeten.
Code:
Sub hsv()
Dim sn, arr, gev, i As Long, j As Long, n As Long
 With Sheets("blad2")
   sn = .Cells(9, 1).CurrentRegion.Offset(3)
   arr = sn
   For i = 1 To UBound(sn)
     gev = Application.Match(sn(i, 1), Sheets("blad1").Columns(3), 0)
        If Not IsError(gev) Then
           n = n + 1
             For j = 1 To UBound(sn, 2) - 1
               arr(n, j) = sn(i, j)
             Next j
         End If
     Next i
    .Cells(9, 1).CurrentRegion.Offset(3).Resize(, 4).ClearContents
    .Cells(9, 1).Offset(3).Resize(n, 4) = arr
 End With
End Sub
 
Harry,
Dat werkt perfect.

Ik heb de code geprobeerd te begrijpen maar kom er niet uit wat er allemaal gebeurd
Is het veel moeite om mij wat uitleg te geven.
Dit ter lering zodat ik er toch ook nog wat van opsteek.

In ieder geval heel erg bedankt. Voor mij ben je een kei.

Vriendelijke groet , Jaap
 
Harry,
Ik ontdek net dat toch niet alles goed gaat.
Die hele rij moet er tussen uit!
Wat in kolom F staat , blijft staan en moet ook weg
Is dit nog te realiseren??
 
Dan moet je de formules aanpassen zodat het verwijderen van de rij(en) er geen invloed op hebben. In kolom G staan nu ook formules.

De code maar weer aangepast naar de nieuwe situatie.

Code:
Sub VenA()
  With Sheets("Blad2")
    .Range("H12:H" & .Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=MATCH(RC[-7],Blad1!C[-5],0)"
    On Error Resume Next
    .Columns(8).SpecialCells(-4123, 16).EntireRow.Delete
    .Columns(8).ClearContents
  End With
End Sub
 

Bijlagen

  • Niet vinden dan wissen.xlsb
    19,3 KB · Weergaven: 51
Of de minst langzaamste.
Code:
Sub hsv()
Dim sn, arr, gev, i As Long, j As Long, n As Long
 With Sheets("blad2")
   sn = .Cells(9, 1).CurrentRegion.Offset(3)
   arr = sn
   For i = 1 To UBound(sn)
     gev = Application.Match(sn(i, 1), Sheets("blad1").Columns(3), 0)
        If Not IsError(gev) Then
           n = n + 1
             For j = 1 To UBound(sn, 2) - 1
               arr(n, j) = sn(i, j)
             Next j
         End If
     Next i
    With .Cells(9, 1).CurrentRegion.offset(3)
        Union(.Resize(, 4), .Columns(6)).ClearContents
       .Resize(n, 4) = arr
    End With
 End With
End Sub
 
Laatst bewerkt:
HSV/VenA

Alles werkt.
Wat is er toch veel mogelijk en wat moet ik nog een hoop leren
MAAAAR , wel heel interessant!!

Beide heel erg bedankt voor de hulp

VenA , als ik nog iets mag vragen.

Als ik in jouw macro "Blad1" wijzig in "Uitslagen noteren" (een spatie tussen twee woorden)
dan gaat het fout. Heb dus ook in de macro Blad1 gewijzigd in Uitslagen noteren
Als ik nu de bladnaam "Uitslagen noteren" toch wil aanhouden , wat moet ik dan in de macro daar neerzetten?
Ik heb het al geprobeerd met een underscore tussen de beide woorden , maar dat is niet de oplossing.
Jaap
 
Net als in alle formules hoort er een enkel quote om de naam van een tab te staan als er spaties in de naam staan. Als je een underscore gebruikt dan is het niet nodig en heb je waarschijnlijk toch nog ergens een spatie staan.

Zoals je in de achtergebleven Module3 kan zien, heb ik eerst even de formule in H12 gezet en daarna een macro opgenomen om de juiste VBA code te krijgen. Zo kan je dus zelf ook vrij eenvoudig dit soort vragen oplossen. Vanuit het immediate window in de VB-editor kan je dmv ?activecell.formula gevolgd door <Enter> ook de VBA vertaling van een formule opvragen.

Paar voorbeeldjes
Code:
?activecell.Formula
=MATCH(A12,'Uitslagen noteren'!C:C,0)
?activecell.Formular1c1
=MATCH(RC[-7],'Uitslagen noteren'!C[-5],0)
?activecell.Formula
=MATCH(A12,Uitslagen_noteren!C:C,0)
?activecell.Formular1c1
=MATCH(RC[-7],Uitslagen_noteren!C[-5],0)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan