Zoek functie in cel als CTR+F

[LauravT]

Hallo,..

Ik ben op zoek naar een formule die ik kan gebruiken zodat de locatie van een zoekwaarde wordt weergegeven.

De zoekwaarde staat 2 cellen naar links van de cel waar ik het resultaat wil hebben.
De mogelijke locatie van de zoekwaarde is verdeeld over 9 tabbladen, wil dan ook alleen de tab weten waar deze staat.
De waarde staat ergens in kolom A, echter het betreft altijd alleen een deel van de cel (geen vaste positie in de tekst).

Het handigste zou zijn dat dit automatische gevuld wordt zodra er gegevens geplakt worden in de cel van de zoekwaarde!

Zie als voorbeeld bijgevoegd bestand!

 

[VenA]

Probeer het zo eens.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:F12")) Is Nothing And Target.Count = 1 Then
    Dim f As Range
    For Each sh In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I"))
        Set f = sh.Columns(1).Find(Target.Value, , xlValues, xlPart)
        If Not f Is Nothing Then
            Target.Offset(, 3) = sh.Name
            Exit For
        End If
    Next sh
End If
End Sub

 

[LauravT]

Top!
Dank je wel!

 

[LauravT]

Met uittesten merk ik nu dat deze code het alleen doet als er per cel direct geplakt wordt!
Het zal bij ons juist vaker voorkomen dat er vanaf kolom A geplakt wordt ipv direct in kolom F en dan doet de code niets,.. !

 

[VenA]

Probeer het zo eens

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A5:H12")) Is Nothing Then
    Dim f As Range
    For Each sh In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I"))
        Set f = sh.Columns(1).Find(Cells(Target.Row, 6), , xlValues, xlPart)
        If Not f Is Nothing Then
            Cells(Target.Row, 9) = sh.Name
            Exit For
        End If
    Next sh
End If
End Sub

 

[A4papiertje]

Ik had dit geschreven. Is niet de beste code waarschijnlijk (begin pas net met VBA) maar bij mij werkt het wel in het test bestandje.

Sub Test()
Kolom = "F" 'Bron Kolom
Rij = 5 'Eerste Rij

Sheets("Waarde").Activate
Do While Rij <= 11 '11 is laatste regel in test bestand
    Waarde = Sheets("Waarde").Range(Kolom & Rij).Value
    x = 1
    Do While x <= 9 '9 tabbladen
        Sheets(x).Activate
            If Not Columns(1).Find(Waarde) Is Nothing Then
                Tabblad = ActiveSheet.Name
                Sheets("Waarde").Range("I" & Rij).Value = Tabblad
            End If
        x = x + 1
    Loop
    Rij = Rij + 1
Loop
Sheets("Waarde").Activate
End Sub

Kolom kun je gewoon "A" van maken als je daar liever de bron inzet.

 

[LauravT]

Bedankt voor de aandragen!
Helaas werkt dit niet als ik het uittest in mijn bestand (heeft waarschijnlijk ook te maken dat sommige niet vindbaar zijn)!

Ik ga iig aan de slag met de eerste code,.. die werkt verder heel goed!

Hartstikke bedankt!

 

[VenA]

Op welk bericht reageer je en wat gaat er mis met de reactie in #5?

 

[LauravT]

Deze code doet het inderdaad als er iets in dezelfde regel geplakt wordt,.. maar niet als er een aantal regels tegelijk geplakt worden!

Bijv ik heb 5 regels gekopieerd, ik plak deze in A5,.. dan wordt in kolom I alleen op regel 5 het resultaat van de juiste tab gegeven en van de rest niet!

 

[VenA]

Probeer het zo maar eens.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A5:H12")) Is Nothing Then
    Application.EnableEvents = False
    Dim f As Range
    ar = Columns(6).SpecialCells(2).Resize(, 4)
    For j = 2 To UBound(ar)
        For Each sh In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I"))
            Set f = sh.Columns(1).Find(ar(j, 1), , xlValues, xlPart)
            If Not f Is Nothing Then
                ar(j, 4) = sh.Name
                Exit For
            End If
        Next sh
    Next j
    [F4].Resize(UBound(ar), 4) = ar
    Application.EnableEvents = True
End If
End Sub

 

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
    
  If Not Intersect(Target, Range("F5:F12")) Is Nothing Then
    For Each it In Target
      For Each sh In Sheets
        it.Offset(, 3) = sh.Columns(1).Find(it).Parent.Name
        If Err.Number = 0 Then Exit For
        Err.Clear
      Next
    Next
  End If
End Sub

 

[LauravT]

Super!
Dit is precies wat ik wil!
Dank je wel!