Sub CompteOccu()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELLule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim cpt As Integer 'déclare la variable cpt (ComPTeur)
Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
.Cells(3, 4).CurrentRegion.ClearContents 'efface les anciennes données
dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne dl de la colonne B
Set pl = .Range("B2:B" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
dico(Left(cel, 5)) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnaire sans doublons
Call Tri(temp, LBound(temp), UBound(temp)) 'lance la procédure de tri croissant du tableau temp
For x = 0 To UBound(temp) 'boucle sur tous les éléments du tableau tri
cpt = 0
.Cells(x + 3, 4).Value = temp(x) 'place l'étiquette
For Each cel In pl
If Left(cel.Value, 5) = temp(x) Then cpt = cpt + 1
Next cel
.Cells(x + 3, 5).Value = cpt 'place le compteur
Next x 'prochain élément de la boucle
End With 'fin de la prise en compte de l'onglet "BDD"
End Sub
Sub Tri(a As Variant, gauc As Integer, droi As Integer) 'tiré du site de Jacques BOISGONTIER [url=http://boisgontierjacques.free.fr/]Formation Excel VBA JB[/url]
Dim ref As Variant
Dim g As Integer, d As Integer
Dim tmp As Variant
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
tmp = a(g): a(g) = a(d): a(d) = tmp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub