Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
mais le résultat de sa macro supprime les doublons d'une colonne dans une autre colonne mais comment puis je faire pour récupérer la liste dans une même cellule séparée de / ? (comme dans mon fichier exemple)
Sub rudy()
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Feuil2")
Set r1 = .Range("C3:C" & .Range("C65000").End(xlUp).Row)
Set r2 = .Range("E3:E" & .Range("E65000").End(xlUp).Row)
For Each c In r1
If Not d.Exists(c.Value) Then
d.Add c.Value, c.Value
Txt = Txt & c & " / "
End If
Next c
For Each c In r1
If Not d.Exists(c.Value) Then
d.Add c.Value, c.Value
Txt = Txt & c & " / "
End If
Next c
End With
Sheets("Feuil1").Range("C5") = Left(Txt, Len(Txt) - 3)
End Sub
une autre façon de faire, avec l'objet "Dictionary"
Code:
Sub unique()
Dim LesValeurs As Object
Dim Cel As Range, Plg As Range
With Sheets("Feuil2")
Set Plg = Union(.Range(.[C3], .[C65000].End(xlUp)), .Range(.[E3], .[E65000].End(xlUp)))
Set LesValeurs = CreateObject("Scripting.Dictionary")
For Each Cel In Plg
If Cel.Value <> "" Then LesValeurs(Cel.Value) = Cel.Value
Next Cel
End With
Sheets("Feuil1").Range("C5").Value = Join(LesValeurs.Items, " / ")
End Sub
Sub unik()
Dim LesValeurs As Object, Cel As Range, Plg As Range
With Sheets("Feuil2")
Set Plg = .UsedRange.SpecialCells(xlCellTypeConstants, 23)
Set LesValeurs = CreateObject("Scripting.Dictionary")
For Each Cel In Plg
LesValeurs(Cel.Value) = Cel.Value
Next Cel
End With
Sheets("Feuil1").Range("C5") = Join(LesValeurs.Items, " / ")
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD