Discussion :

[apt]

Bonjour à tous,

Dans la colonne A, j’ai des données sous forme S-x-y

Dans la colonne B, j’ai des données sous forme de zRi, zBG, zUD.

S-13-0
S-16-0
S-16-1
S-1-14 4RI
S-10-0 20RI
S-10-2 24RI
S-10-5 30BG
S-10-1 31RI
S-10-7 34UD
S-12-11 39RI
S-11-12 40RI

J’aimerais comptabiliser dans un tableau les sous ensemble suivants :

-Y dans la colonne A (Ex : Le S-10 contient 5 sous ensemble)

-RI qui correspond à l’ensemble (S-x) dans la colonne A (Ex : il y a 3 RI dans l’ensemble S-10)

-BG qui correspond à l’ensemble (S-x) dans la colonne A (Ex : il y a 1 BG dans l’ensemble S-10)

-UD qui correspond à l’ensemble (S-x) dans la colonne A (Ex : il y a 1 UD dans l’ensemble S-10)

Merci d’avance.

EDIT :

Pour un début, voila un code qui répond au premier point (comptabiliser le nombre des ensemble dans la colonne A)

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
Sub CompteOccuSP()
    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    'déclare la variable cel (CELLule)
    Dim temp As Variant    'déclare la variable temp (tableau TEMPoraire)
    Dim x 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, 1).End(xlUp).Row    'définit la dernière ligne dl de la colonne B
        Set pl = .Range("A2:A" & dl)    'définit la plage pl
        For Each Cel In pl    'boucle sur toutes les cellules cel de la plage pl
            'Cel2 = Left(Cel, 3)
            Cel2 = Split(Cel, "-")(1)
            'MsgBox "Cel2 = " & Cel2 & vbCrLf & _
             '       "dico = " & dico(Cel2) & ", dc+1 = " & dico(Cel2) + 1
 
            dico(Cel2) = dico(Cel2) + 1  '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
        [D1] = "S": [E1] = "P"
        For x = 0 To UBound(temp)    'boucle sur tous les éléments du tableau tri
 
            .Cells(x + 2, 4).Value = temp(x)     'place l'étiquette
            .Cells(x + 2, 5).Formula = dico.Item(temp(x))
            '.Cells(x + 2, 6).Value = ?
            '.Cells(x + 2, 7).Value = ?
            '.Cells(x + 2, 8).Value = ?
        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

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
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