Excel - Power Query - Power Pivot - VBA

VBA17 | Totaliser les ventes par client

Énoncé

  • Thème : objet Dictionary (bibliothèque Scripting) | Durée : 35 min | Niveau : avancé.
  • Classeur de départ : VBA17_ventes.xlsm (feuilles Ventes et Synthèse).
  • Contexte : le service commercial veut le chiffre d'affaires de chaque client, sans tableau croisé dynamique ni formule. Vous utilisez l'objet Dictionary de la bibliothèque Scripting : d'abord en liaison tardive avec CreateObject, puis en liaison anticipée après avoir coché la référence Microsoft Scripting Runtime. Vous regroupez les montants par clé, réglez la comparaison des clés et retirez des éléments.

Travail demandé

  • Ouvrir le classeur, puis l'éditeur Visual Basic (Alt+F11) et le module Module1.
  • Compter les clients avec un Dictionary en liaison tardive : macro CompterClients.
  • Cocher la référence Microsoft Scripting Runtime.
  • Totaliser le CA par client en liaison anticipée : macro TotaliserParClient.
  • Regrouper les clés sans tenir compte de la casse : macro TotaliserParClient modifiée.
  • Renvoyer un Dictionary et retirer des clés : macro ClientsPrincipaux.
  • Répondre au questionnaire de fin de lab (5 questions, 80 % pour valider).

Compter les clients avec un Dictionary en liaison tardive

Sub CompterClients()
Dim dClients As Object
Dim ws As Worksheet
Dim ligne As Long
Dim client As String

    Set dClients = CreateObject("Scripting.Dictionary")
    Set ws = Worksheets("Ventes")
    For ligne = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        client = ws.Cells(ligne, 3).Value
        If Not dClients.Exists(client) Then
            dClients.Add client, ligne
        End If
    Next ligne
    Debug.Print "Clients différents : "; dClients.Count
End Sub
  • Un Dictionary range des paires clé / élément, et chaque clé est unique. CreateObject("Scripting.Dictionary") le crée sans référence à cocher : c'est la liaison tardive. La variable est alors As Object et l'éditeur ne propose pas les membres après le point.
  • Tapez la macro dans Module1, puis lancez-la par F5. Le résultat s'affiche dans la fenêtre Exécution (Ctrl+G). Gardez ce nombre en tête : il cache une anomalie.
  • Résultat attendu :
    • La fenêtre Exécution affiche Clients différents : 7

Cocher la référence Microsoft Scripting Runtime

  • Dans l'éditeur Visual Basic : Outils > Références, cochez Microsoft Scripting Runtime, puis OK.
  • La référence donne accès aux types de la bibliothèque Scripting : Dim d As Scripting.Dictionary et New Scripting.Dictionary. C'est la liaison anticipée : l'éditeur propose les membres, vérifie le code à la compilation et l'exécution est plus rapide. Dans la suite de la formation, on utilise toujours la liaison anticipée.
  • Le classeur garde la référence : un collègue qui l'ouvre n'a rien à cocher.

Totaliser le CA par client en liaison anticipée

Sub TotaliserParClient()
Dim dCA As Scripting.Dictionary
Dim ws As Worksheet, wsSynthese As Worksheet
Dim ligne As Long
Dim cle As Variant

    Set dCA = New Scripting.Dictionary
    Set ws = Worksheets("Ventes")
    For ligne = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        dCA(ws.Cells(ligne, 3).Value) = dCA(ws.Cells(ligne, 3).Value) + ws.Cells(ligne, 5).Value
    Next ligne
    Set wsSynthese = Worksheets("Synthèse")
    wsSynthese.Range("A1:B20").ClearContents
    wsSynthese.Range("A1").Value = "Client"
    wsSynthese.Range("B1").Value = "CA HT"
    ligne = 2
    For Each cle In dCA.Keys
        wsSynthese.Cells(ligne, 1).Value = cle
        wsSynthese.Cells(ligne, 2).Value = dCA(cle)
        ligne = ligne + 1
    Next cle
    Debug.Print dCA.Count; "clients totalisés"
End Sub
  • dCA(cle) = dCA(cle) + montant fait tout le travail : lire une clé absente l'ajoute avec une valeur vide (Empty, qui vaut 0 dans une addition). For Each cle In dCA.Keys parcourt les clés dans leur ordre d'ajout. On passe .Value et non la cellule : sinon la clé serait l'objet Range lui-même.
  • Tapez Dim dCA As Scripting. : la saisie semi-automatique propose Dictionary, puis les membres après dCA.
  • Résultat attendu :
    • La feuille Synthèse liste 7 lignes de clients avec leur CA HT

Regrouper les clés sans tenir compte de la casse

  • Dans TotaliserParClient, ajoutez la ligne CompareMode juste après New :
    Set dCA = New Scripting.Dictionary
    dCA.CompareMode = vbTextCompare
  • Par défaut, CompareMode vaut vbBinaryCompare : « Atelier Morin » et « ATELIER MORIN » sont deux clés. Avec vbTextCompare, elles n'en font qu'une. CompareMode se règle avant le premier ajout, sinon l'erreur 5 se produit.
  • Relancez la macro.
  • Résultat attendu :
    • La feuille Synthèse ne compte plus que 6 clients, Atelier Morin à 11 860 €

Renvoyer un Dictionary et retirer des clés

Function TotauxParClient() As Scripting.Dictionary
Dim dCA As Scripting.Dictionary
Dim ws As Worksheet
Dim ligne As Long

    Set dCA = New Scripting.Dictionary
    dCA.CompareMode = vbTextCompare
    Set ws = Worksheets("Ventes")
    For ligne = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        dCA(ws.Cells(ligne, 3).Value) = dCA(ws.Cells(ligne, 3).Value) + ws.Cells(ligne, 5).Value
    Next ligne
    Set TotauxParClient = dCA
End Function

Sub ClientsPrincipaux()
Dim dCA As Scripting.Dictionary
Dim cles As Variant
Dim i As Long

    Set dCA = TotauxParClient()
    cles = dCA.Keys
    For i = LBound(cles) To UBound(cles)
        If dCA(cles(i)) < 5000 Then dCA.Remove cles(i)
    Next i
    Debug.Print "Clients à 5 000 € ou plus : "; Join(dCA.Keys, ", ")
    Debug.Print "Total : "; Application.WorksheetFunction.Sum(dCA.Items)
End Sub
  • Une fonction peut renvoyer un Dictionary (Set TotauxParClient = dCA). Pour retirer des clés en parcourant le dictionnaire, on copie d'abord dCA.Keys dans un tableau : on ne modifie pas une collection pendant qu'on la parcourt avec For Each. Keys et Items renvoient des tableaux indicés à partir de 0.
  • Résultat attendu :
    • La fenêtre Exécution affiche les 4 clients à 5 000 € ou plus et leur total 45 190

Pour aller plus loin