Met Worksheet Change aangemaakt sleutelveld vertikaal zoeken in ander Excel sheet

[Beearnd]

Hallo,

- Via een eerder gestelde vraag heb ik onderstaande code 1 verkregen, deze werkt perfect;
- Deze code1 maakt een sluetelveld aan;
- Nu zou ik graag willen dat met de nieuw samengestelde sleutel, gegevens in een andere excel sheet worden opgezocht en bijgeplatst;
- Vertikaal zoeken dus, maar het is mogelijk dat de sleutel er niet in staat;
- Heb verschillende geprobeerd, o.a. code 2 die ik op dit forum gevonden heb;
- In bijgevoegde sheet heb ik een voorbeeld geplaatst hoe het eruit moet zien, via opzoeken moeten de velden AM, AN en AO gevuld worden.

Vriendelijk verzoek om mij op het goede pad te zetten

Beearnd


CODE 1 Zoeksleutel aanmaken

Private Sub Worksheet_Change(ByVal Target As Range)
'' Zoeksleutel aanmaken
If Not Intersect(Target, Range("D13:D2013")) Is Nothing Then
  If Target.Count > 1 Then
      For Each cl In Range("D13:D2013")
           If cl <> vbNullString Then cl.Offset(, 34) = Range("M3").Value & cl.Value
      Next
      Else
      Target.Offset(, 34) = Range("M3").Value & Target.Value
   End If
End If
End Sub

CODE 2
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Blad2.UsedRange.Columns(1), Target) Is Nothing Then Target.Offset(, 2) = Data.UsedRange.Columns(1).Find(Target).Offset(, 1)
End Sub

 

[snb]

Kun je svp VBA code tuseen code tags zetten ?

 

[Elsendoorn2134]

Beernd,

Probleem is niet zo groot, probeer bijgaande code:
In de cellen wordt met VBA een formule geplaatst, wil je een waarde dan zal je deze moeten omzetten
met een kopiëren speciaal.

Private Sub Worksheet_Change(ByVal Target As Range)
 
' Zoeksleutel aanmaken
If Not Intersect(Target, Range("D13:D2013")) Is Nothing Then
    
    If Target.Count > 1 Then
        For Each cl In Range("D13:D2013")
            If cl <> vbNullString Then
                cl.Offset(, 34) = Range("M3").Value & cl.Value
                cl.Offset(, 35) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,2,FALSE)"
                cl.Offset(, 36) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,3,FALSE)"
                cl.Offset(, 37) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,4,FALSE)"
            End If
        Next
    Else
        Target.Offset(, 34) = Range("M3").Value & Target.Value
        Target.Offset(, 35) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,2,FALSE)"
        Target.Offset(, 36) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,3,FALSE)"
        Target.Offset(, 37) = "=VLOOKUP(RC38,Opzoekblad!R2C1:R7C4,4,FALSE)"
    End If
End If

End Sub

Veel Succes.

 

[Beearnd]

Beste Elsendoorn

- Werkt, hier kan ik goed mee uit de voeten;
- bedankt.

Beearnd

 

[snb]

of:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("D13:D2013")) Is Nothing Then Exit Sub
    
    For Each cl In Target
        If cl <> vbNullString Then cl.Offset(, 34).Resize(, 4) = Sheets("Opzoekblad").Columns(1).Find(Range("P4").Value & cl.Value, , xlValues, 1).Resize(, 4).Value
    Next
End Sub

 

[Beearnd]

Beste Elsendoorn,

- De tweede aanpassing is mooier, maar hoe moet er nu gecodeerd worden als de opzoektabel niet in het zelfde werkboek staat maar op een schijf elders?

Beearnd

 

[snb]

Dat kun je eenvoudig zelf aanpassen. (ooit al eens een macro opgenomen ?)

 

[Beearnd]

Opzoeken extern bestand geeft fout 9 Het subscript valt buiten het bereik

Beste Elsendoorn,

- Heb verschillende methoden geprobeerd, maar krijg telkens fout 9 runtime error;
- Ter verduidelijking heb ik de bestanden toegevoegd;
- Hoop dat ik op het goede spoor gezet kan worden.

Met vriendelijke groet

BeearndBekijk bijlage Helpmij3.xlsxBekijk bijlage VoorbeeldHelpmij2.xlsm

 

[Beearnd]

Help!