Sub test()
Dim TabBase() As Variant
TabBase = Range(Cells(3, 3), Cells(5, 12))
Dim TabRes() As Variant
ReDim TabRes(1 To UBound(TabBase, 1) * UBound(TabBase, 2), 1 To 5)
cpt = 1
For i = 1 To UBound(TabBase, 1)
For j = 1 To UBound(TabBase, 2)
Debug.Print TabBase(i, j)
TabRes(cpt, 1) = TabBase(i, j)
Debug.Print TabRes(cpt, 1)
cpt = cpt + 1
Next j
Next i
' repére le doublon !
For i = 1 To UBound(TabRes, 1)
For j = i + 1 To UBound(TabRes, 1)
If TabRes(i, 1) = TabRes(j, 1) Then
TabRes(j, 2) = "Doublon"
End If
Next j
Next i
' Compteur du nombre de fois qu'il y a le numéro !
For i = 1 To UBound(TabRes, 1)
For j = 1 To UBound(TabRes, 1)
If TabRes(i, 1) = TabRes(j, 1) Then
TabRes(i, 3) = TabRes(i, 3) + 1
TabRes(i, 4) = TabRes(i, 3) & TabRes(i, 1)
TabRes(i, 5) = "Il y a " & TabRes(i, 3) & " fois le NB : " & TabRes(i, 1) & " x dans le Tableau"
End If
Next j
Next i
'Cells(13, 6).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
' tri
Call Tri(TabRes(), 4, LBound(TabRes, 1), UBound(TabRes, 1))
'Cells(13, 6).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
cpt = Empty
Dim TabAff() As Variant
' Compte le NB ligne sans doublon !
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 2) <> "Doublon" Then
cpt = cpt + 1
End If
Next i
ReDim TabAff(1 To cpt, 1 To 1)
cpt = 1
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 2) <> "Doublon" Then
TabAff(cpt, 1) = TabRes(i, 5)
cpt = cpt + 1
End If
Next i
Cells(22, 2).Resize(UBound(TabAff, 1), UBound(TabAff, 2)) = TabAff
End Sub
Sub Tri(TabRes(), ColTri, gauc, droi) ' Quick sort
ref = TabRes((gauc + droi) \ 2, ColTri)
g = gauc: d = droi
Do
Do While TabRes(g, ColTri) < ref: g = g + 1: Loop
Do While ref < TabRes(d, ColTri): d = d - 1: Loop
If g <= d Then
For k = LBound(TabRes, 2) To UBound(TabRes, 2)
temp = TabRes(g, k): TabRes(g, k) = TabRes(d, k): TabRes(d, k) = temp
Next k
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(TabRes, ColTri, g, droi)
If gauc < d Then Call Tri(TabRes, ColTri, gauc, d)
End Sub
