XL 2013 Concaténer 2 colonnes Puis Supprimer Doublons

[Chris401]

Bonsoir à tous

Je cherche un code pour concaténer 2 colonnes puis supprimer les doublons.
Je sais le faire en passant auparavant par une formule dans la feuille, puis un code pour supprimer les doublons, mais mon fichier peut contenir énormément de lignes ; aussi je pense qu'il vaudrait mieux utiliser une "mémoire" tableau et/ou CreateObject("Scripting.Dictionary") pour gagner en temps d'exécution.

Merci par avance.

 

[Hieu]

Salut Chris,

J'ai concaténé et verifié le doublon via excel, puis écrit les valeurs recherchées.
Un début de piste.

Sub mlk()
Set BA = Sheets("Base")
Set RE = Sheets("Resultat")
Do
If BA.Range("k2").Offset(i, 0) = False Then
    RE.Range("a3").Offset(k, 0) = BA.Range("j2").Offset(i, 0)
    k = k + 1
End If
i = i + 1
Loop Until IsEmpty(BA.Range("k2").Offset(i, 0))
End Sub

 

[Chris401]

Bonsoir Hieu et merci de ton aide

Cependant, comme je l'ai indiqué dans mon message, j'ai déjà la solution en passant d'abord par une formule dans la feuille et c'est ce que je voudrais éviter.

Bonne fin de soirée

 

[Hieu]

Au temps pour moi, j'ai lu entre les lignes ^^

 

[Modeste]

Salut chris401, Hieu,

Pour bien dormir, quelque chose comme:

Sub sansDoublons()
tablo = Feuil1.[F2].Resize(Application.CountA(Feuil1.[F:F]), 3)
Set liste = CreateObject("scripting.dictionary")
For i = 1 To UBound(tablo)
    liste(tablo(i, 1) & tablo(i, 3)) = ""
Next i
Sheets("Resultat").[A3].Resize(liste.Count, 1) = Application.Transpose(liste.keys)
End Sub

 

[Chris401]

Bonsoir Modeste

Tout simplement PARFAIT
Je teste demain le temps de réponse sur mon fichier réel.

Merci beaucoup
Je peux aller dormir maintenant.

Bonne nuit à tous

 

[Yurperqod]

Bonjour le forum

Une macro en utilisant Données/Supprimer les doublons

Sub Macro1()
Dim DerLigne As Long
Sheets("Base").Copy after:=Sheets(Sheets.Count)
DerLigne = ActiveSheet.Range("F1").End(xlDown).Row
Range("J1") = "SupprD"
With Range("J2:J" & DerLigne)
    .FormulaR1C1 = "=RC[-4]&RC[-2]"
    .Value = .Value
End With
Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlYes
Range(Cells(2, "J"), Cells(Rows.Count, "J").End(xlUp)).Copy Sheets("Resultat").Range("A3")
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
End Sub