1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Sub test()
Dim liste As Object
Dim fin As Long, cptr As Long
Dim Lign As Byte
Dim entree As String
Dim tablo
Dim num
Dim Col
'boucle sur les colonnes A, D, E, F, G, H, I, J, L de la feuille "Feuil1"
'colonnes représentées ici par le Range("A1,D1:J1,L1") A ADAPTER
For Each Col In Worksheets("Feuil1").Range("A1,D1:J1,L1").Columns
'extrait les occurences des valeurs uniques
With Sheets("Feuil1")
fin = .Columns(Col.Column).Cells(.Cells.Rows.Count, "A").End(xlUp).Row
tablo = .Range(.Cells(1, Col.Column), .Cells(fin, Col.Column)).Value
Set liste = CreateObject("scripting.dictionary")
For cptr = 1 To UBound(tablo)
entree = tablo(cptr, 1)
If Not liste.exists(entree) Then liste.Add entree, entree
Next
End With
'restitution feuil3 colonne A (Columns(1)) toutes les données les unes
'sous les autres
With Sheets("Feuil3")
Lign = .Columns(1).Cells(.Cells.Rows.Count, "A").End(xlUp).Row + 1
For Each num In liste
.Cells(Lign, 1) = liste.Item(num)
Lign = Lign + 1
Next
End With
Next Col
End Sub |
Partager