Bonsoir à tous,

Pour cette première phase de comptage, j’ai en colonne A, des chiffres triés, allant de 0 à 12000.

En colonne I, j’ai un tableau d’intitulés, et en colonne J les ensembles affectées à ces intitulés.

Intitulé Ensemble
TT [0-5]
TT [6-8]
ZYR [9-15]
SRG [16-21]
SRG [30-52]
FDR [22-25]

Les ensembles sont sous forme de [x-y] (Commence à x et se termine par y).

Alors en colonne C, j’aimerais mettre seulement les ensembles qui ont leurs valeurs dans la colonne A.

En colonne D, le total des valeurs trouvées de chaque ensemble dans la colonne A.

Par exemple :

En colonne A :
0
1
2
3
4
5
6
7
8
9
10
11

En colonne C (Ensemble) et D (Total), on devra avoir :

Ensemble Total
[0-5] 6
[6-9] 4
[10-25] 2

Mais voila le code suivant, compte bien ces totaux, mais ne les affiche pas dans la colonne D.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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, Cel2 As Range   'déclare la variable cel (CELLule)
    Dim temp As Variant    'déclare la variable temp (tableau TEMPoraire)
    Dim Ens() As String, Min As Integer, Max As Integer, Cpt As Integer
    Dim x As Integer, y As Integer
    Application.ScreenUpdating = False
    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, 10).End(xlUp).Row    'définit la dernière ligne dl de la colonne B
        Set pl = .Range("J2:J" & dl)    'définit la plage pl
        For Each Cel In pl    'boucle sur toutes les cellules cel de la plage pl
        'MsgBox "Cel Ens = " & Cel
            Ens = Split(Cel, "-")
            Min = Mid(Ens(0), 2): Max = Mid(Ens(1), 1, Len(Ens(1)) - 1)
            '-- Nombre de valeur max à trouver
            Cpt = (Max - Min) + 1: y = 1
            For Each Cel2 In .Range("A2:A13000")
                If Cel2 >= Min And Cel2 <= Max Then
                    dico(Cel) = dico(Cel) + 1  'alimente le dictionnaire
                    y = y + 1
               ElseIf y > Cpt Then
                    Exit For
                End If
            Next Cel2
        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
        [C1] = "Ensemble": [D1] = "Total"
        For x = 0 To UBound(temp)    'boucle sur tous les éléments du tableau tri
            .Cells(x + 2, 3).Value = temp(x)     'place l'étiquette
            .Cells(x + 2, 4).Formula = dico.Item(temp(x)) 'place le total résultant
        Next x    'prochain élément de la boucle
    End With    'fin de la prise en compte de l'onglet "BDD"
    Application.ScreenUpdating = True
End Sub
 
Sub Tri(a As Variant, gauc As Integer, droi As Integer)    'tiré du site de Jacques BOISGONTIER http://boisgontierjacques.free.fr/
    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
Merci d'avance.