XL 2016 [RESOLU] RechercheV et Lien_hypertexte

[Mulder]

Bonjour à tous,
Je cherche une âme charitable qui saura me dépanner...
Ma problématique :
J'ai un onglet qui regroupe mes données : feuille source.
J'ai un onglet (feuille résultats) dans lequel, via une RECHERCHEV, je vais récupérer des données de la feuille source.
Certaines de ces données à récupérer intègrent un lien hypertexte, d'autres non.
Je vous joins un fichier allégé pour me faire comprendre.

Mon problème :
J'ai besoin que le RECHERCHEV me récupère le lien hypertexte uniquement quand il ne existe un dans la feuille source. En l'état, actuellement, il m'en crée un systématiquement, et quand je clique dessus pour les résultats qui devraient afficher un lien, celui-ci renvoie "Impossible d'ouvrir le fichier spécifié".

Est-il possible en combinant RECHERCHEV et LIEN_HYPERTEXTE, de donner un résultat qui n'inclue le lien que quand c'est nécessaire ?
Si je dois passer par une macro, je suis preneur aussi...

D'avance merci.

 

[job75]

Bonjour Mulder,

En Feuille source entrez en C1 la formule :

=GAUCHE(CELLULE("filename";A1);TROUVE("[";CELLULE("filename";A1))-1)&"Cagette.pdf"

En B1 vous pouvez conserver le lien hypertexte ou le supprimer puis entrer la formule :

=LIEN_HYPERTEXTE(C1;"Photo de la cagette")

En Feuille résultats entrez en B2 :

=SIERREUR(SI(RECHERCHEV(A2;'Feuille source'!A:C;3;FAUX)="";"";LIEN_HYPERTEXTE(RECHERCHEV(A2;'Feuille source'!A:C;3;FAUX);RECHERCHEV(A2;'Feuille source'!A:B;2;FAUX)));"")

A+

 

[Mulder]

Bonjour job75,
Ca ne convient pas tout à fait : si j'intègre vos formules et que je copie vers le bas, en colonne "C" je fais toujours référence à Cagette, alors que ça peut changer. Sachant que le nom du fichier auquel renvoie le fichier hypertexte n'est pas forcément intitulé comme ce qui est mentionné en colonne B.

 

[job75]

Re,

Voici une solution VBA, perso je préfère.

Placez dans le code de Feuille résultats (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim r As Range
On Error Resume Next 'si la colonne A est vide
Set r = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then Liens r
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("A2:A" & Rows.Count), Me.UsedRange)
If Not r Is Nothing Then Liens r
End Sub

Sub Liens(r As Range)
Dim c As Range
Application.ScreenUpdating = False
For Each r In r
  r(1, 2).Clear
  If r <> "" Then
    Set c = Feuil2.[A:A].Find(r, , xlValues, xlWhole)
    If Not c Is Nothing Then c(1, 2).Copy r(1, 2)
  End If
Next
End Sub

La 1ère macro se déclenche chaque fois qu'on active la feuille.

La 2ème macro chaque fois qu'on modifie/valide une ou plusieurs cellules en colonne A.

Bien sûr le fichier doit être enregistré en .xlsm.

Bonne soirée.

 

[job75]

Re,

Pour répondre à votre post #3, il n'y a pas de formule Excel permettant de récupérer l'adresse d'un lien.

Donc avec la solution du post #2 il faut pour chaque ligne adapter manuellement la fin de la formule en colonne C.

C'est aussi pour cela que je préfère la solution VBA du post #4.

A+

 

[job75]

Re,

Bien sûr la copie des cellules une par une prend du temps avec la macro Worksheet_Activate.

Mais il vaut mieux utiliser pour la recherche Application.Match (EQUIV) c'est plus rapide que la méthode Find :

Private Sub Worksheet_Activate()
Dim r As Range
On Error Resume Next 'si la colonne A est vide
Set r = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then Liens r
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("A2:A" & Rows.Count), Me.UsedRange)
If Not r Is Nothing Then Liens r
End Sub

Sub Liens(r As Range)
Dim i As Variant
Application.ScreenUpdating = False
With Feuil2 'CodeName de la feuille source
  For Each r In r
    r(1, 2).Clear
    If r <> "" Then
      i = Application.Match(r, .[A:A], 0)
      If IsNumeric(i) Then .Cells(i, 2).Copy r(1, 2)
    End If
  Next
End With
End Sub

J'ai testé avec 1000 noms différents en colonne A (tous avec lien), les mêmes dans les 2 feuilles :

- avec Find => environ 7 secondes sur Win 10 - Excel 2013

- avec Application.Match => environ 3,5 secondes.

A+

 

[Mulder]

Impeccable, exactement ce qu'il me fallait.
Merci job75 !!

 

[Mulder]

Salut Job75,
Je reviens vers toi car j'ai besoin d'adapter ta macro, qui fonctionne très bien au demeurant, à mon fichier.
J'ai peut être trop simplifié la version de tests publiée ici et du coup je n'arrive pas à l'adapter parce que je ne comprends pas tout (notamment parce que la feuille source et la feuille résultat ont la même structure dans mon exemple basique, alors que dans la réalité, ce n'est pas le cas).

Ci-joint un nouveau fichier plus adapté à mon fichier final (les valeurs à chercher et les valeurs sources sont dans les mêmes colonnes que mon fichier final).
Particularité qui n'était pas évoqué précédemment : je n'ai pas un seul onglet source mais plusieurs (11 dans mon fichier final, ici 2 dans mon exemple (Fruits et Légumes), sachant que via une formule, je détermine le nom de la feuille où chercher mon lien hypertexte en colonne N).

Penses-tu pouvoir réadapter ta macro à cette trame ?
Elle fait appel à des fonctions que je ne connais pas (application.match, isnumeric....).
D'avance merci.

 

[job75]

Bonsoir Mulder,

Il faut une cohérence des colonnes entre les feuilles 'Fruit', 'Légume' etc...

Ce n'était pas le cas pour la colonne B de la feuille 'Fruit', j'ai donc corrigé.

Le code adapté :

Private Sub Worksheet_Activate()
Dim r As Range
On Error Resume Next 'si la colonne F est vide
Set r = Range("F10:F" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then Liens r
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("F10:F" & Rows.Count), Me.UsedRange)
If Not r Is Nothing Then Liens r
End Sub

Sub Liens(r As Range)
Dim i As Variant
Application.ScreenUpdating = False
For Each r In r
  r(1, 8).Clear
  If r <> "" And r(1, 9) <> "" Then
    i = Application.Match(r, Sheets(r(1, 9).Text).[A:A], 0)
    If IsNumeric(i) Then Sheets(r(1, 9).Text).Cells(i, 2).Copy r(1, 8)
  End If
Next
End Sub

Fichier joint.

A+

 

[job75]

Bonjour Mulder, le forum,

Vous dites que les noms des feuilles en colonne N sont déterminés par formule.

Cela nécessite un tableau de correspondance.

On peut aussi les déterminer par recherche dans toutes les feuilles :

Private Sub Worksheet_Activate()
On Error Resume Next 'si la colonne F est vide
Liens Range("F10:F" & Rows.Count).SpecialCells(xlCellTypeConstants)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, Range("F10:N" & Rows.Count), Me.UsedRange)
If Not r Is Nothing Then Liens Intersect(r.EntireRow, [F:F])
End Sub

Sub Liens(r As Range)
Dim i As Variant, w As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité
For Each r In r
  r(1, 8).Resize(, 2).Clear 'RAZ
  If r <> "" Then
    For Each w In Worksheets 'recherche dans toutes les feuilles
      i = Application.Match(r, w.[A:A], 0)
      If IsNumeric(i) Then
        w.Cells(i, 2).Copy r(1, 8)
        r(1, 9) = w.Name 'facultatif
        Exit For
      End If
    Next w
  End If
Next r
Application.EnableEvents = True 'réactive les évènements
End Sub

Evidemment le traitement prend un peu plus de temps.

Fichier (2).

Edit : j'ai mis 1000 noms en colonne F renvoyant sur 11 feuilles, tous avec lien.

Chez moi la macro Worksheet_Activate s'exécute alors en 3,8 secondes.

Bonne journée.