Bonsoir Pierrejean,Bonjour cp4
A tester
Pierrejean,Re
Version permettant la création d'un tableau(tabsort)
Sub doublon()
'tRes est le tableau résultat
Dim tSource, tRes, dico, i&, n&, k&, clef
tSource = Sheets("Feuil1").Range("a1:b" & Sheets("Feuil1").Cells(Rows.Count, "a").End(xlUp).Row)
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tSource): dico(tSource(i, 1) & tSource(i, 2)) = i: Next i
ReDim tRes(1 To dico.Count, 1 To 2)
For Each clef In dico
n = n + 1: k = dico(clef)
tRes(n, 1) = tSource(k, 1): tRes(n, 2) = tSource(k, 2)
Next clef
End Sub
Merci beaucoup @mapomme , ça fonctionne aussi bien que le code de Pierrejean (que je salue).Bonsoir @cp4, à tous,
Un autre code ?:
VB:Sub doublon() 'tRes est le tableau résultat Dim tSource, tRes, dico, i&, n&, k&, clef tSource = Sheets("Feuil1").Range("a1:b" & Sheets("Feuil1").Cells(Rows.Count, "a").End(xlUp).Row) Set dico = CreateObject("Scripting.Dictionary") For i = 2 To UBound(tSource): dico(tSource(i, 1) & tSource(i, 2)) = i: Next i ReDim tRes(1 To dico.Count, 1 To 2) For Each clef In dico n = n + 1: k = dico(clef) tRes(n, 1) = tSource(k, 1): tRes(n, 2) = tSource(k, 2) Next clef End Sub
Sub es()
Dim t(), m As Object, z, x As Long, i As Long
t = Feuil1.Range("a2:b" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
Set m = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
z = t(i, 1) & t(i, 2)
If Not m.Exists(z) Then
m.Add z, z: x = x + 1
t(x, 1) = t(i, 1): t(x, 2) = t(i, 2)
End If: Next i
Feuil2.[a2].Resize(x, 2) = t
End Sub
C'est parfait.bonjour les amis
un autre code manipulant Add
VB:Sub es() Dim t(), m As Object, z, x As Long, i As Long t = Feuil1.Range("a2:b" & Feuil1.Cells(Rows.Count, 1).End(3).Row) Set m = CreateObject("Scripting.Dictionary") For i = 1 To UBound(t) z = t(i, 1) & t(i, 2) If Not m.Exists(z) Then m.Add z, z: x = x + 1 t(x, 1) = t(i, 1): t(x, 2) = t(i, 2) End If: Next i Feuil2.[a2].Resize(x, 2) = t End Sub
pas trop présente depuis quelques mois
maman depuis peu eh!!!oui
gros bisous a tous (e)