XL 2016 recherche de la valeur d'une cellule dans une autre feuille

[dcas]

Bonjour, je vous joins un fichier "recherche"
dans celui-ci j'ai deux feuilles et je voudrais créer un lien hyper_texte entre ces deux feuilles
c'est à dire que dans ma Feuil1 lorsque je clique sur ma case h1 je voudrais rechercher et afficher automatiquement dans feuil2 la valeur identique à h2 de feuil1

si quelqu'un a une idée je suis preneur ,car là je sèche !

merci
Damien

 

[djidji59430]

Bonjour à tous,

Pas trés claires, tes explications.
remets ton fichier avec un ou deux résultats que tu voudrais trouver.


Crdlmt

 

[dcas]

Voilà,j'ai créé le lien .quand je clique sur h1(42656) la feuille2 s'ouvre sur la case 42656
là crée le lien en déterminant la cellule de destination
mais je souhaiterai qu'il cherche tout seul dans toute la colonne A de la feuille 2 et ça pour toutes les cellules de la colonne H de feuille 1

cordialement

 

[WTF]

Hello,
Je ne sais pas comment créer le lien automatiquement (regardes la formule =LIENHYPERTEXTE() ), mais voici les adresses des cellules sur lesquels tu souhaites que ca pointe

 

[djidji59430]

Re
Un essai :

 

[dcas]

Hello,
Je ne sais pas comment créer le lien automatiquement (regardes la formule =LIENHYPERTEXTE() ), mais voici les adresses des cellules sur lesquels tu souhaites que ca pointe

merci je vais creuser!

 

[job75]

Bonjour dcas, djidji59430, WTF,

Voyez le fichier joint et la macro du bouton :

Private Sub CommandButton1_Click()
Dim c As Range, i As Variant
Application.ScreenUpdating = False
With UsedRange.Columns(8)
    .Hyperlinks.Delete 'RAZ
    .Columns(0).AutoFill .Columns(0).Resize(, 2), xlFillFormats 'couleurs d'origine
    .NumberFormat = "0"
    For Each c In .Cells
        i = Application.Match(c, Feuil2.Columns(1), 0)
        If IsNumeric(i) Then Hyperlinks.Add c, "", "'" & Feuil2.Name & "'!A" & i
    Next
End With
End Sub

A+

 

[dcas]

Bonjour dcas, djidji59430, WTF,

Voyez le fichier joint et la macro du bouton :

Private Sub CommandButton1_Click()
Dim c As Range, i As Variant
Application.ScreenUpdating = False
With UsedRange.Columns(8)
    .Hyperlinks.Delete 'RAZ
    .Columns(0).AutoFill .Columns(0).Resize(, 2), xlFillFormats 'couleurs d'origine
    .NumberFormat = "0"
    For Each c In .Cells
        i = Application.Match(c, Feuil2.Columns(1), 0)
        If IsNumeric(i) Then Hyperlinks.Add c, "", "'" & Feuil2.Name & "'!A" & i
    Next
End With
End Sub

A+

Bonjour job75,
un grand merci pour ton aide.ta solution fonctionne
les liens sont bien crées jusqu’à la ligne 101590 puis j'ai une erreur(je te joins deux captures d'écran de cette erreur)
il faut dire que j'ai 233048 lignes dans mon fichier
si tu as une idée pour finir le travail ,je suis preneur

cordialement

 

[job75]

Normalement la macro fonctionne quel que soit le nombre de lignes.

Je ne suis pas arrivé à reproduire ce bug.

 

[job75]

Notez que le nombre de liens hypertextes dans une feuille de calcul est limité à 66530 :

https://support.office.com/fr-fr/ar...-à-Excel-1672b34d-7043-467e-8e27-269d656771c3

Edit : en Feuil1 j'ai recopié la plage A1:H19 sur A1:H190000 => la macro beugue en effet.

 

[job75]

S'il y a un grand nombre de liens l'instruction .Hyperlinks.Delete prend trop de temps, utilisez alors :

Private Sub CommandButton1_Click()
Dim mem, c As Range, i As Variant
Application.ScreenUpdating = False
With UsedRange.Columns(8)
    mem = .Value 'mémorise
    .Clear 'RAZ
    .Columns(0).AutoFill .Columns(0).Resize(, 2), xlFillFormats 'couleurs d'origine
    .NumberFormat = "0"
    .Value = mem 'restitue
    For Each c In .Cells
        i = Application.Match(c, Feuil2.Columns(1), 0)
        If IsNumeric(i) Then Hyperlinks.Add c, "", "'" & Feuil2.Name & "'!A" & i
    Next
End With
End Sub

 

[job75]

Avec un tableau structuré on évite d'avoir à recopier les formats, fichier (2) avec :

Private Sub CommandButton1_Click()
Dim mem, c As Range, i As Variant
Application.ScreenUpdating = False
With UsedRange.Columns(8)
    mem = .Value 'mémorise
    .Clear 'RAZ
    .Value = mem 'restitue
    For Each c In .Cells
        i = Application.Match(c, Feuil2.Columns(1), 0)
        If IsNumeric(i) Then Hyperlinks.Add c, "", "'" & Feuil2.Name & "'!A" & i
    Next
End With
End Sub

Pour tester j'ai recopié le tableau A2:H20 sur 133 000 lignes.

La création des 63 000 liens se fait chez moi en 15 secondes.

 

[dcas]

Avec un tableau structuré on évite d'avoir à recopier les formats, fichier (2) avec :

Private Sub CommandButton1_Click()
Dim mem, c As Range, i As Variant
Application.ScreenUpdating = False
With UsedRange.Columns(8)
    mem = .Value 'mémorise
    .Clear 'RAZ
    .Value = mem 'restitue
    For Each c In .Cells
        i = Application.Match(c, Feuil2.Columns(1), 0)
        If IsNumeric(i) Then Hyperlinks.Add c, "", "'" & Feuil2.Name & "'!A" & i
    Next
End With
End Sub

Pour tester j'ai recopié le tableau A2:H20 sur 133 000 lignes.

La création des 63 000 liens se fait chez moi en 15 secondes.

bonjour job75 merci pour ton aide
c'est bon grâce à toi j'ai réussi ,mais il a fallu que je sépare ma feuille de 233000 lignes en 4 feuilles
Merci
@+