Macro pour creer renvoi vers celulle

[fredh]

Bonjour a tous

Voila je suis en train de mettre a jour une liste de fournisseurs, mais beaucoup de fournisseur sont soit obsolete, soit repris par un autre, soit changement de nom.

Explication :
en Colonne B j'ai le nom de fournisseur
en colonne D j'ai l'adresse du fournisseur, ou alors le nom du nouveau fournisseur

J'aimerai faire une recherche du texte en D2 (nouveau fournisseur) dans la colonne B et si jamais la macro trouve le meme texte alors creer en D2 un renvoi vers Bxx.

Pour le renvoi on peut utiliser ceci :

    Selection.Hyperlinks(1).SubAddress = "feuille!Bxx"

Je vais essayer de commencer un code tout seul mais si quelqu'un a des idée quand la methode a suivre je suis biens sur preneur.

Merci et @+

ci dessous un fichier en exemple

 

[porcinet82]

Re : Macro pour creer renvoi vers celulle

Salut,

Essaye le code suivant, je n'ai pas de quoi le tester a fond mais ca a l'air de fonctionner, du moins si j'ai bien compris ta demande, ce qui n'est pas forcement gagné.

Sub recherche()
Dim i%
For i = 7 To Range("B65536").End(xlUp).Row
    If Cells(i, 2).Value = Cells(2, 4).Value Then
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:="", SubAddress:="Feuille!" & Cells(i, 2).Address(0, 0)
        Exit Sub
    End If
Next i
End Sub

Tiens nous au courant,

@+

 

[fredh]

Re : Macro pour creer renvoi vers celulle

Bonjour porcinet82
Merci de repondre
Ton code est presque bon, j'ai corriger ce qui est en rouge pour que ca coresponde a ma demande.
Il faudrait aussi qu'il fasse la recherche sur les autres celulle de la colonne D.
Le code ne fait que la recherche du contenu de D2 et pas D3, D4, D5 etc...
Pourquoi for i = 7 alors que la recherche doit commencer a partir de B2 ?

[LEFT]Sub recherche()
Dim i%
For i = 7 To Range("B65536").End(xlUp).Row
If Cells(i, 2).Value = Cells(2, 4).Value Then
  ActiveSheet.Hyperlinks.Add Anchor:=Cells([COLOR=red]2, 4[/COLOR]), Address:="", SubAddress:="Feuille!" & Cells(i, 2).Address(0, 0)
  Exit Sub
End If
Next i
End Sub[/LEFT]

De mon coter j'ai fait cela mais ca a rien a voir avec ton code qui est beaucoup plus court.

Sub renvoi()
Dim Start As String, Cherche As String, StartAdr As String, TrouveAdr As String
Dim Trouve As Range
Start = Range("D2").Address
Cherche = Range(Start).Value
With Range("B2:B65536")
    Set Trouve = .Find(Cherche, LookIn:=xlValues)
    If Not Trouve Is Nothing Then
        StartAdr = Trouve.Address
        Do
        ActiveSheet.Hyperlinks.Add Anchor:=Range(Start), Address:="", _
            SubAddress:="feuille!" & Trouve.Address(RowAbsolute:=False)
        'Set Trouve = .FindNext(Trouve)
        Loop While Not Trouve Is Nothing And Trouve.Address <> StartAdr
    End If
End With
End Sub

Je vais essayer de continuer sur ta voix.

Pour mieux comprendre ma demande je joint un fichier en exemple avec les deux code a l'interieur

Merci et @+

 

[fredh]

Re : Macro pour creer renvoi vers celulle

Wouaw on y est presque....

Sub recherche2()
Dim i%, [COLOR=blue]j%[/COLOR]
[COLOR=blue]For j = 2 To Range("D65536").End(xlUp).Row[/COLOR]
For i = [COLOR=blue]2[/COLOR] To Range("B65536").End(xlUp).Row
    If Cells(i, 2).Value = Cells([COLOR=blue]j[/COLOR], 4).Value [COLOR=red]And Cells(j, 4) <> ""[/COLOR] Then
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(j, 4), Address:="", SubAddress:="Feuille!" & Cells(i, 2).Address(0, 0)
  [COLOR=lime]  '    Exit Sub[/COLOR]
    End If
Next i
[COLOR=blue]Next j[/COLOR]
End Sub

Il faut encore que je gere le phenomeme quand les celulle sont vide...
en effet si D10= "" et B50 = "" alors la celulle D10 me renvois sur B50...

Pas bon mais je crois pouvoir y arriver (edit voir en rouge dans le code).

J'attend encore ton aprobation sur mes modif parce que j'ai utiliser une partie de ton code que je ne comprend pas (mais qui marche quand même).

[COLOR=#0000ff]For j = 2 To Range("D65536").End(xlUp).Row[/COLOR]

En attendant un grand merci pour ton aide rapide et efficace
@+