Comparer deux colonnes

[akhlan]

Hello,

Dans un classeur, j'ai sur une feuille "Export_Serveurs", une colonne "H" contenant un liste de noms (avec doublons) et sur une seconde feuille "URL_Notes", une colonne "C" avec ces mêmes noms mais formatés en liens hypertexte (un par nom).

Je voudrais que les noms de la colonne "H" prennent la valeur de la colonne "C", c'est à dire que les différents noms se transforment en liens hypertexte via une boucle ou autre (les différentes colonnes peuvent parfois être vides).

Pour le moment sur ma feuille "URL_Notes", j'ai cette macro:

Dim lig As Long, DerLig As Long

Sub Macro1()

DerLig = Sheets("URL_Notes").Range("A65536").End(xlUp).Row
For lig = 2 To DerLig
ActiveSheet.Hyperlinks.Add Anchor:=Range("C" & lig), Address:=Range("B" & lig).Value, TextToDisplay _
:=Range("A" & lig).Value
Next lig

End Sub

qui me permet de concaténer le nom (colonne A) et l'url (colonne B) afin de créer la colonne C

Vous auriez une idée pour m'aider ?

Akhlan

 

[MichD]

Re : Comparer deux colonnes

Bonjour,


Tu dois ajouter la référence suivante à ton projet VBA:
barre des menus / outils / références / et tu coches :
"Microsoft Scripting Runtime"

Les cellules de la colonne H:H vont se transformer en lien hypertexte
en reprenant le lien hypertexte qui leur sont attribuée en colonne C:C
pour un même nom.

C'est plus concluant avec un fichier exemple comme explication.

Sub Test()
Dim Dic As Dictionary, C As Range
Dim t(), A As Long, N As Variant, X As Integer
Dim DerLig As Long, Trouve As Range
Set Dic = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False
Application.EnableEvents = False

With Worksheets("Feuil1")
     With .Range("C65536")
        DerLig = .End(xlUp).Row
     End With
     For Each C In .Range("C1:C" & DerLig)
         If C <> "" Then
             If Not Dic.exists(C.Value) Then
                 Dic.Add C.Value, C.Hyperlinks(1).Address
             End If
         End If
     Next
     With .Range("H:H")
        For A = 0 To Dic.Count - 1
            Set Trouve = .Find(What:=Dic.keys(A), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole)
            If Not Trouve Is Nothing Then
                adr = Trouve
                Do
                    Trouve.Hyperlinks.Add Anchor:=Trouve, _
                                    Address:=Dic.items(A)
                    Set Trouve = .FindNext(Trouve)
                Loop Until Trouve = adr
            End If
        Next
    End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[akhlan]

Re : Comparer deux colonnes

Je reprends le boulot à 14h30, je vais tester ça...

Merci en tout cas

Akhlan