verplaatsen

[don42]

Hoi Allemaal,

voorbeeld bestandje (jaja )

wil graag als ik in blad 1 in kolom a een naam selecteer
deze naam gezocht wordt in kolom A van blad2 en dan waar deze naam staat kolom E selecteren
Nu wordt elke keer kolom/cel E5 geselecteerd.

Don

 

[SjonR]

zo?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Application.Intersect(Range("a5:a23"), Target) Is Nothing Then
         response = MsgBox("Je mag hier niks invullen... " & vbNewLine & "Wil je naar het tabblad blad2", vbQuestion + vbYesNo, "Helpmij.nl     ©")
         If response = vbNo Then Exit Sub
         Application.Goto Sheets("blad2").Cells(Application.Match(Target, Sheets("Blad2").Range("A1:A23"), 0), 1).Offset(, 4)
 End If
End Sub

 

[don42]

helemaal goed

Precies wat ik graag wou hebben
hier kan ik weer mee verder
bedankt maar weer voor je fijne hulp
Don

 

[don42]

SjorR

ik heb er uiteindelijk dit van gemaakt:

If Not Application.Intersect(Range("a4:a133"), Target) Is Nothing Then
  If Sheets("Controle").Cells(Application.Match(Target, Sheets("Controle").Range("A4:A133"), 0), 1).Offset(3, 2).Value = "" Then
  response = MsgBox("Je hebt " & ActiveCell & " geselecteerd,... " & vbNewLine & "Er zijn nog geen ATV en roostervrije dagen ingevoerd" & vbNewLine & "Klik op oké om hier naar toe te gaan", vbQuestion + vbYesNo, "VC-Roermond     ©")
   If response = vbNo Then Exit Sub
    Application.Goto Sheets("Controle").Cells(Application.Match(Target, Sheets("Controle").Range("A4:A133")[COLOR="#FF0000"], 0), 1)[/COLOR].Offset(3, 2)
  
 Else
 response = MsgBox("Je hebt " & ActiveCell & " geselecteerd,... " & vbNewLine & "Invoer reeds gedaan " & vbNewLine & "Wil je dit toch aanpassen?", vbQuestion + vbYesNo, "VC-Roermond     ©")
  If response = vbNo Then Exit Sub
    Application.Goto Sheets("Controle").Cells(Application.Match(Target, Sheets("Controle").Range("A4:A133")[COLOR="#FF0000"], 0), 1)[/COLOR].Offset(3, 2)
     End If
      End If

wat dat het door mij rood gearceerde?
Don

 

[don42]

als ik deze code in mijn voorbeeldje gebruikt (#1) werkt het ook
maar niet in de code van (#4)

 Application.Goto Sheets("blad2").Cells(Application.Match(Target, Sheets("Blad2").Range("A1:A23"), 0), 5)

wil graag het verschil weten

 

[VenA]

Wat is de bedoeling van deze code? Er klopt niet zo heel veel van. In #4 heet 'Blad2' 'Controle'. De code onder de Else zal nooit uitgevoerd worden.

 

[don42]

Oei,
hoi VenA


ik heb het voorbeeldje gemaakt om dit later zelf aan te passen in mijn file die ik gebruik voor het verlof aanvraag van mijn werkgever
en daar verwijs ik dus naar tabblad controle ipv blad 2 (dat had ik al aangepast)
overigens heb ik het geheel prima werkende,
Ik wil graag de code lezen en begrijpen en zag even niet wat er gebeurd met [CODE], 0), 1).Offset(3, 2)[/CODE]
dat was enkel de vraag.

 

[VenA]

Hoe kan je het prima werkend hebben met code die niet werkt?
Match heeft een derde parameter vandaar de 0. Cells heeft een rij- en kolomnummer nodig vandaar de 5. Met offset kan je verschuiven ten opzichte van de huidige cel.

Mij lijkt dit beter

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range
  If Intersect(Target, Range("A4:A133")) Is Nothing Then Exit Sub
    Set r = Sheets("Controle").Columns(1).SpecialCells(2).Find(Target.Value, , xlValues, xlWhole)
    If Not r Is Nothing Then
      If MsgBox("Je hebt " & Target.Value & " geselecteerd,... " & vbNewLine & IIf(r.Offset(, 4).Value = "", "Er zijn nog geen ATV en roostervrije dagen ingevoerd", "Invoer reeds gedaan ") _
        & vbNewLine & IIf(r.Offset(, 4).Value = "", "Klik op oké om hier naar toe te gaan", "Wil je dit toch aanpassen?"), vbQuestion + vbYesNo, "VC-Roermond     ©") = vbYes Then
        Application.Goto r.Offset(, 4)
      End If
     Else
      If MsgBox("De naam " & Target.Value & " bestaat niet. Toevoegen?", vbQuestion + vbYesNo, "VC-Roermond     ©") = vbYes Then Application.Goto Sheets("Controle").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
End Sub

 

[don42]

thanks
Dit is echt hoge school
:thumb: