Re : Tirage sur un colonne sans doublons (grd base données )
voici le macro j'ai adapté:
Sub test()
Dim a(), tbl, item
Dim dico As New Dictionary, mondico As New Dictionary 'si problème tu commentes mettre ' en début de ligne
Dim i As Long, j As Long, indice As Long, clé As String, clébase As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set dico = CreateObject("scripting.dictionary") 'si problème tu décommentes
Feuil4.Range("A5
1000").ClearContents
tbl = Feuil3.UsedRange
j = 1
For i = 5 To UBound(tbl, 1)
dico(tbl(i, 11)) = tbl(i, 11)
Next
For Each item In dico.Items
Set mondico = CreateObject("scripting.dictionary") 'si problème tu décommentes
For i = 5 To UBound(tbl, 1)
If tbl(i, 11) = item Then
clébase = item
clé = clébase
indice = 1
Do While mondico.Exists(clé)
clé = clébase & indice
indice = indice + 1
Loop
mondico(clé) = i
End If
Next i
clébase = item
clé = clébase
indice = 1
Do While mondico.Exists(clé)
ligne = mondico(clé)
ReDim Preserve a(1 To 16, 1 To j)
a(1, j) = tbl(ligne, 1)
a(2, j) = tbl(ligne, 2)
a(3, j) = tbl(ligne, 3)
a(4, j) = tbl(ligne, 4)
a(5, j) = tbl(ligne, 5)
a(6, j) = tbl(ligne, 6)
a(7, j) = tbl(ligne, 7)
a(8, j) = tbl(ligne, 8)
a(9, j) = tbl(ligne, 9)
a(10, j) = tbl(ligne, 10)
a(11, j) = tbl(ligne, 11)
a(12, j) = tbl(ligne, 12)
a(13, j) = tbl(ligne, 13)
a(14, j) = tbl(ligne, 14)
a(15, j) = tbl(ligne, 15)
a(16, j) = tbl(ligne, 16)
clé = clébase & indice
indice = indice + 1
If j < 20 Then j = j + 1 ' adapter 20
Loop
Next item
a = Application.Transpose(a)
Feuil4.Range("A5").Resize(UBound(a, 1), UBound(a, 2)) = a 'c'est pr copy coller?
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic