Discussion :

[vicky_3003]

Bonsoir à tous,

J'ai quelques difficultés de compréhension sur une macro que j'applique un peu "bêtement" dans mes tableaux , serait-il possible que l'un(e) d'entre vous me détaille chaque étape ?

Mille fois merci !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub SousTotal3()
  a = Range("A2:B" & [a65000].End(xlUp).Row)
  Dim b(): ReDim b(1 To UBound(a), 1 To 2)
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j, 1) = a(i, 1)
    Do While a(i, 1) = b(j, 1)
      b(j, 2) = b(j, 2) + a(i, 2)
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
  [E2].Resize(UBound(b), UBound(b, 2)) = b
End Sub

[clementmarcotte]

Bonjour,

Le meilleur moyen de comprendre à quoi sert un mot-clef, c'est le truc universel des VB Microsoft.

Un clic sur un mot-clef et

Aussi utile. (Surtout pour déboguer, mais aussi pour voir ce qui se passe):

Exécuter la procédure au pas-à-pas (F8) et examiner ce qui se passe dans la feuille et suivre la valeur des variables dans la fenêtre "Espions"

[joe.levrai]

Bonjour,

sauf erreur, cette procédure réalise un sous total des identifiants de la colonne A, en additionnant les valeurs de la colonne B
le résultat est écrit en colonne E/F

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
Sub SousTotal3()
Dim a()
Dim b()
 
' on prend les deux colonnes
a = Range("A2:B" & [a65000].End(xlUp).Row)
 
' on crée un tableau de même taille
ReDim b(1 To UBound(a), 1 To 2)
 
' pour descendre dans les lignes du tableau a
i = 1
' pour monter dans les lignes du tableau b
j = 0
 
 
' tant qu'on a pas dépassé les lignes de a
Do While i <= UBound(a)
    ' on descend d'une ligne dans b
    j = j + 1
 
    ' la colonne  1 de b reçoit la valeur de a
    b(j, 1) = a(i, 1)
 
    ' tant que la colonne 1 de b = celle de a
    Do While a(i, 1) = b(j, 1)
        ' la colonne 2 de b est incrémentée par la colonne 2 de a
        b(j, 2) = b(j, 2) + a(i, 2)
        ' on descend d'une ligne dans a
        i = i + 1
        ' si on a dépassé les lignes de a on s'arrête
        If i > UBound(a) Then Exit Do
    Loop
Loop
 
' écriture de b en colonne E et F
[E2].Resize(UBound(b), UBound(b, 2)) = b
 
End Sub

Il y a beaucoup moins compliqué ... il suffit d'utiliser la fonction SOMME.SI() de Excel après avoir extrait la liste sans doublon des identifiants de la colonne A
Pour rester dans la simplicité, on va utiliser l'outil "Supprimer les doublons" plutôt qu'un dictionnaire.
Ce n'est pas optimisé (boucle sur chaque identifiant pour calculer le sous-total) mais au moins c'est pas compliqué à comprendre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Toto()
Dim Cell As Range
    Columns(1).Copy Columns(5) ' copie de la colonne A vers la colonne E
    Columns(5).RemoveDuplicates Columns:=1, Header:=xlNo  ' suppression des doublons
    ' formule SOMME.SI
    For Each Cell In Range(Cells(2, 5), Cells(2, 5).End(xlDown)).Cells 
        Cell.Offset(0, 1).Value = Application.WorksheetFunction.SumIf(UsedRange.Columns(1), Cell.Value, UsedRange.Columns(2))
    Next Cell
End Sub

[vicky_3003]

Bonjour,

Merci à vous deux pour vos réponses, elles me sont très utiles

J'aurai souhaité savoir s'il était possible d'appliquer une fonction If avant l'écriture suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
[Ici]
 ' tant que la colonne 1 de b = celle de a
    Do While a(i, 1) = b(j, 1)
        ' la colonne 2 de b est incrémentée par la colonne 2 de a
        b(j, 2) = b(j, 2) + a(i, 2)
        ' on descend d'une ligne dans a
        i = i + 1

J'ai essayé de faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
' si 2015 alors colonne 2
If a(i, 2) = 2015 Then
    Do While a(i, 1) = b(j, 1)
    ' la colonne 2 de b reçoit la valeur de a
    b(j, 2) = b(j, 2) + a(i, 3)
    i = i + 1
'si 2016
Else
    Do While a(i, 1) = b(j, 1)
    'la colonne 3 de b reçoit la valeur de a
    b(j, 3) = b(j, 3) + a(i, 3)
    i = i + 1
    End If

Mais la syntaxe ne semble pas bonne, else sans if ... Je ne comprends pas

Merci !

[halaster08]

Bonjour, tu n'a pas fermer tes boucles while (avec un "loop" normalement) donc le else est considéré à l'interieur du while.

[vicky_3003]

Merci pour les boucles

Ma macro marche mais j'ai un petit problème concernant le résultat final.

Je m'explique :

Dans mon tableau j'ai des données qui concernent une année N et N+1, ici 2015 2016.
La macro fait bien le tri entre 2015 et 2016 pour les opérations sur une année unique, soit en 2015 soit en 2016.

Si, admettons que "Paul" a enregistré 10 puis 20 en 2015 et 20 et 40 en 2016, là la macro m’impute le total de ces 4 opérations dans la colonne 2016.

Tandis que, si Paul avait enregistré uniquement 10 et 20 en 2015, rien en 2016 (et inversement), là ça marche. La macro impute bien la somme des deux opérations dans la colonne 2015 ...

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
Sub SousTotal()
 
Dim a()
Dim b()
 
' on prend les trois colonnes
a = Range("A2:C" & [a65000].End(xlUp).Row)
 
' on crée un tableau de même taille
ReDim b(1 To UBound(a), 1 To 3)
 
' pour descendre dans les lignes du tableau a
i = 1
' pour monter dans les lignes du tableau b
j = 0
 
' tant qu'on a pas dépassé les lignes de a
Do While i <= UBound(a)
    ' on descend d'une ligne dans b
    j = j + 1
 
    ' la colonne  1 de b reçoit la valeur de a
    b(j, 1) = a(i, 1)
 
' si 2015 alors colonne 2
    If a(i, 2) = 2015 Then
        Do While a(i, 1) = b(j, 1)
            ' la colonne 2 de b reçoit la valeur de a
            b(j, 2) = b(j, 2) + a(i, 3)
            i = i + 1
            If i > UBound(a) Then Exit Do
        Loop
 
    'si 2016
    Else
        Do While a(i, 1) = b(j, 1)
            'la colonne 3 de b reçoit la valeur de a
            b(j, 3) = b(j, 3) + a(i, 3)
            i = i + 1
            If i > UBound(a) Then Exit Do
        Loop
 
    End If
 
Loop
' écriture de b en colonne F,G,H
[F2].Resize(UBound(b), UBound(b, 2)) = b
 
End Sub