Zoeken op laatste gedeelte van nummer

bascas · 3 jan 2012

Hallo, in kolom E in bijgevoegde sheet komen allemaal kaartnummers te staan van 13 cijfers. Nu kan ik in cel F3 zo'n nr intikken en excel brengt mij dan naar het betreffende tabblad. Maar.... is het mogelijk excel te laten zoeken in die 13 cijfers op alleen de laatste 8. Dus kaartnummer is 2610412345678, excel moet het tabblad al geven bij 12345678.

Overigens, wil je de sheet testen, vul eerst kolom B,C,E,F in dan een nummer geven in A. Zo wordt het gebruikt.

Groet Bas

Bekijk bijlage Personeelskorting.xls

Roncancio · 3 jan 2012

Bij het invoeren van een waarde wordt gekeken of er een werkblad waarvan de naam gelijk is aan de laatste 8 cijfers van cel F3.

Code:

If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
    For Each WS In Worksheets
        If WS.Name = Right(Target, 8) Then WS.Select
    Next
End If

Zo ja, dan wordt dit werkblad geselecteerd.

Met vriendelijke groet,

Roncancio

bascas · 3 jan 2012

Roncancio, bedankt voor je hulp, maar waar zou ik die code tussen moeten plakken, heb het op verschillende plaatsen geprobeerd, maar krijg het niet werkend.

Groet Bas

Roncancio · 3 jan 2012

Bij worksheet_Change.

Met vriendelijke groet,

Roncancio

bascas · 3 jan 2012

Roncancio, het zal aan mijn onkunde liggen maar krijg het niet voor elkaar, waar moet het precies tussen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
    If Target.Column = 1 And Target <> "" Then
        Sheets("1").Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Target
        Sheets(Sheets.Count).Unprotect "bascas"

        Sheets(Sheets.Count).Range("C3").Value = ActiveSheet.Name
        Sheets("Main").Range(Target.Address).Offset(0, 7) = "=" & Target & "!$D$46"
        Sheets("Main").Range(Target.Address).Offset(0, 8) = "=" & Target & "!$I$46"
        Sheets("Main").Range(Target.Address).Offset(0, 9) = "=" & Target & "!$N$46"
        Sheets("Main").Range(Target.Address).Offset(0, 10) = "=" & Target & "!$S$46"
        Sheets("Main").Range(Target.Address).Offset(0, 11) = "=" & Target & "!$T$46"
        Sheets("Main").Range("D" & Target.Row).Formula = "=HYPERLINK(""" & Target & "!A1" & """,""" & Target & """)"
    ElseIf Not Intersect(Target, Range("F3")) Is Nothing And Target <> "" Then
        Set knr = Range("E8:E" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    
    ElseIf Not Intersect(Target, Range("F5")) Is Nothing And Target <> "" Then
        Set knr = Range("B9:B" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    End If
    
End If
Sheets(Sheets.Count).Protect "bascas"

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c
   For Each c In Sheets("Main").Range("D8:D250")
    If c > 0 Then
      c.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="'" & c.Value & "'!A1", TextToDisplay:=" " & c.Value
    End If
  Next
End Sub

Groet Bas

Roncancio · 3 jan 2012

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
    If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
        For Each WS In Worksheets
            If WS.Name = Right(Target, 8) Then WS.Select
        Next
    End If
    If Target.Column = 1 And Target <> "" Then
        Sheets("1").Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Target
        Sheets(Sheets.Count).Unprotect "bascas"

        Sheets(Sheets.Count).Range("C3").Value = ActiveSheet.Name
        Sheets("Main").Range(Target.Address).Offset(0, 7) = "=" & Target & "!$D$46"
        Sheets("Main").Range(Target.Address).Offset(0, 8) = "=" & Target & "!$I$46"
        Sheets("Main").Range(Target.Address).Offset(0, 9) = "=" & Target & "!$N$46"
        Sheets("Main").Range(Target.Address).Offset(0, 10) = "=" & Target & "!$S$46"
        Sheets("Main").Range(Target.Address).Offset(0, 11) = "=" & Target & "!$T$46"
        Sheets("Main").Range("D" & Target.Row).Formula = "=HYPERLINK(""" & Target & "!A1" & """,""" & Target & """)"
    ElseIf Not Intersect(Target, Range("F3")) Is Nothing And Target <> "" Then
        Set knr = Range("E8:E" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    
    ElseIf Not Intersect(Target, Range("F5")) Is Nothing And Target <> "" Then
        Set knr = Range("B9:B" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    End If
    
End If
Sheets(Sheets.Count).Protect "bascas"

End Sub

Met vriendelijke groet,

Roncancio

bascas · 3 jan 2012

Rocancio bedankt voor je moeite, maar er gaat iets niet goed. Heb nu de code geplakt zoals je schreef maar het werkt niet. De sheet staat hier
http://www.mijnbestand.nl/Bestand-8C7F4JCFFYVU.xls

Groet Bas

Cobbe · 4 jan 2012

Probeer eens met deze aanpassing:

Code:

For Each WS In Worksheets
        If [COLOR="red"]Right(WS.Name, 8)[/COLOR] = Right(Target, 8) Then WS.Select
    Next

bascas · 4 jan 2012

Heren, ik weet al waarom het niet werkt, waarschijnlijk was mijn vraagstelling niet goed en is de oplossing dus niet wat ik zoek. Ik probeer het opnieuw.

Op het blad "main" vul je in de volgorde B, C, E, F de gevraagde gegevens in. Vervolgens geven in kolom A van de betreffende medewerker het pers. nr. in. Dit wordt dan ook de naam van het tabblad( dat is verder ook niet belangrijk). Nu is het de bedoeling dat je in F5 kunt zoeken op de laatste 8 cijfers van de gegevens die in kolom E staan. Dus iemand heeft kaartnummer 1234512345678. Dan moet excel al naar het tabblad gaan na ingave van 12345678.
Hoop dat het zo iets duidelijker is, en nog steeds mogelijkheden bied voor een oplossing

Groet Bas

HierEnNu · 4 jan 2012

Het werkt niet omdat gezocht wordt naar een werkblad met de in de naam de cijfers 12345678. dat werlblad is er niet. Deze waarde staat nl. in een cel op een werkblad. Verwijs daarom naar de cel (c6) waarin het kaartnummer staat vermeld.
zo werkt het wel:

Code:

If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
    For Each WS In Worksheets
        If [COLOR="red"]Right(WS.[c6], 8)[/COLOR] = Right(Target, 8) Then WS.Select
    Next

bascas · 4 jan 2012

Beste HierenNu,

Ik heb nu van alles geprobeert, maar krijg het niet werkend. Kun je de volledige VBA code incusief dat stukje misschien hier neer zetten, zodat ik kan zien ik fout doe?

Groeten Bas

HierEnNu · 4 jan 2012

Hierbij de hele code, maar die is verder niet verandert.
Bij mij werkt het prima. Vul de laatste 8 cijfers van het kaartnr. in bij F3 en druk op enter.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
    For Each WS In Worksheets
        If Right(WS.[c6], 8) = Right(Target, 8) Then WS.Select
    Next
End If
    If Target.Column = 1 And Target <> "" Then
        Sheets("1").Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Target
        Sheets(Sheets.Count).Unprotect "bascas"

        Sheets(Sheets.Count).Range("C3").Value = ActiveSheet.Name
        Sheets("Main").Range(Target.Address).Offset(0, 7) = "=" & Target & "!$D$46"
        Sheets("Main").Range(Target.Address).Offset(0, 8) = "=" & Target & "!$I$46"
        Sheets("Main").Range(Target.Address).Offset(0, 9) = "=" & Target & "!$N$46"
        Sheets("Main").Range(Target.Address).Offset(0, 10) = "=" & Target & "!$S$46"
        Sheets("Main").Range(Target.Address).Offset(0, 11) = "=" & Target & "!$T$46"
        Sheets("Main").Range("D" & Target.Row).Formula = "=HYPERLINK(""" & Target & "!A1" & """,""" & Target & """)"
    ElseIf Not Intersect(Target, Range("F3")) Is Nothing And Target <> "" Then
        Set knr = Range("E8:E" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    
    ElseIf Not Intersect(Target, Range("F5")) Is Nothing And Target <> "" Then
        Set knr = Range("B9:B" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    End If
    
End If
Sheets(Sheets.Count).Protect "bascas"

End Sub

bascas · 4 jan 2012

Toppie, het werkt. En ik weet ook wat ik fout deed!

Groet Bas

bascas · 5 jan 2012

Toch nog een klein probleempje. Welke eigenschappen geef ik de cel waarin de cijfers komen waarnaar gezocht wordt. Want als ik nu een rekeningnummer heb wat met 2 nullen begint haalt excel deze weg na de enter, en vindt hij de gevraagde sheet niet.

Groet Bas

Roncancio · 5 jan 2012

Celeigenschappen op Tekst zetten.

Met vriendelijke groet,

Roncancio

bascas · 5 jan 2012

Je wil niet weten wat ik allemaal heb geprobeerd. Bedankt.
Groet Bas

bascas · 6 jan 2012

Toch nog een probleem.

Heb de sheet gevuld met wat namen, en loop dan tegen Fout 13 aan in VBA. Bestand gevuld is inmiddels te groot dus het staat hier http://www.mijnbestand.nl/Bestand-SIOPV37OFEB3.xls

Hoop dat jullie een oplossing hebben

groet Bas

Roncancio · 6 jan 2012

Dat komt omdat er een foutmelding staat in cel C6 van werkblad 999.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
    For Each ws In Worksheets
[COLOR="red"]        If Not IsError(ws.[C6]) Then[/COLOR]
            If Right(ws.[C6], 8) = Right(Target, 8) Then ws.Select
[COLOR="red"]        End If[/COLOR]
    Next
End If
    If Target.Column = 1 And Target <> "" Then
        Sheets("999").Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Target
        Sheets(Sheets.Count).Unprotect "bascas"

        Sheets(Sheets.Count).Range("C3").Value = ActiveSheet.Name
        Sheets("Main").Range(Target.Address).Offset(0, 7) = "=" & Target & "!$D$46"
        Sheets("Main").Range(Target.Address).Offset(0, 8) = "=" & Target & "!$I$46"
        Sheets("Main").Range(Target.Address).Offset(0, 9) = "=" & Target & "!$N$46"
        Sheets("Main").Range(Target.Address).Offset(0, 10) = "=" & Target & "!$S$46"
        Sheets("Main").Range(Target.Address).Offset(0, 11) = "=" & Target & "!$T$46"
        Sheets("Main").Range("D" & Target.Row).Formula = "=HYPERLINK(""" & Target & "!A1" & """,""" & Target & """)"
    ElseIf Not Intersect(Target, Range("F3")) Is Nothing And Target <> "" Then
        Set knr = Range("E8:E" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    
    ElseIf Not Intersect(Target, Range("F5")) Is Nothing And Target <> "" Then
        Set knr = Range("B9:B" & Rows.Count).Find(Target, , xlValues, xlWhole)
        If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
    End If
    
End If
Sheets(Sheets.Count).Protect "bascas"

End Sub

De rode regels zijn toegevoegd zodat de foutmelding wordt omzeild.

Met vriendelijke groet,

Roncancio

bascas · 17 jan 2012

Bedankt allen, het werkt!:thumb:

Zoeken op laatste gedeelte van nummer

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Giga Honourable Senior Member †

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Gebruiker

Meubilair

Gebruiker

Wij waarderen jouw privacy