Somme de valeur en VBA

  • Initiateur de la discussion Initiateur de la discussion tyruso
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

tyruso

XLDnaute Junior
Bonjour,

J'ai un classeur excel avec 1 onglet "Résultat" et des onglets par mois de l'année.
Sur les onglets des mois, j'ai des données qui sont de la forme:
Client | CA | KM
toto | 1000 | 500
Loulou | 2000 | 525
toto | 400 | 250

J'ai créer une macro qui me permet d'afficher une synthese par le mois que je choisi:

Sub VALID()

[A5😀300].ClearContents

Dim mois As String

mois = Worksheets("RESULTAT").Range("B" & 3)
j = 5
For i = 1 To 65536
If Application.Workbooks("PORTEFEUILLE 2012 V2.xlsm").Worksheets(mois).Range("A" & i).Value = Application.Workbooks("PORTEFEUILLE 2012 V2.xlsm").Worksheets("RESULTAT").Range("B" & 2).Value Then
Application.Workbooks("PORTEFEUILLE 2012 V2.xlsm").Worksheets("RESULTAT").Range("A" & j & ":C" & j).Value = Application.Workbooks("PORTEFEUILLE 2012 V2.xlsm").Worksheets(mois).Range("B" & i & "😀" & i).Value
j = j + 1
End If
Next i

End Sub

J'ai donc bien tout mes clients qui s'affiche les uns apres les autres.

Ce que j'aimerais c'est que cette macro ne m'affiche pas les doublons mais fasse la somme du CA et KM.
Dans mon exemple, au lieu d'avoir 2 lignes avec TOTO, en avoir une seule avec TOTO | 1400 | 750

Quelqu'un pourrait-il m'aider?

Merci
 
Re : Somme de valeur en VBA

Bonjour Tyruso, bonjour le forum,

Mais si, mais si... Il suffit d'être patient...
Je te propose le code ci-dessous :
Code:
Option Explicit

Sub VALID()
Dim m As Object 'déclare la variable m (Mois)
Dim ca As Integer 'déclare la variable ca (Code Agence)
Dim dlm As Integer 'déclare la variable dlm (Dernière Ligne du Mois)
Dim plm As Range 'déclare la variable plm (PLage du Mois)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim r1 As Range 'déclare la variable r1 (Recherche 1)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim r2 As Range 'déclare la variable r2 (Recherche 2)
Dim i As Byte 'déclare la variable i (Incrément)

Range("A5:D1200").ClearContents 'efface la plage A5:D1200
Set m = Sheets(Range("B3").Value) 'définit l'onglet m
ca = Range("B2").Value 'définit le code agance ca
dlm = m.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dlm de la colonne A de l'onglet m
Set plm = m.Range("A1:A" & dlm) 'définit la plage plm
Set r1 = plm.Find(ca, , xlValues, xlWhole) 'définit la recherche r1 (recherche le code agence dans la colonne A de l'onglet du mois)
If Not r1 Is Nothing Then 'condition 1 : si il existe au moins une occurrence trouvée
    pa = r1.Address 'définit l'adresse de la première occurrence trouvée
    Do 'exécute
        Set r2 = Columns(1).Find(r1.Offset(0, 1), , xlValues, xlWhole) 'définit la recherche r2 (recherche le code client dans la colonne A de l'onglet "RESULTAT"
        If Not r2 Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            r2.Offset(0, 1).Value = r2.Offset(0, 1).Value + r1.Offset(0, 2).Value 'additionne les valeurs de la colonne B
            r2.Offset(0, 2).Value = r2.Offset(0, 2).Value + r1.Offset(0, 3).Value 'additionne les valeurs de la colonne C
        Else 'sinon
            Set dest = Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            For i = 0 To 2 'boucle sur le décalage de 0 à 3
                dest.Offset(0, i).Value = r1.Offset(0, i + 1).Value 'récupère la valeur de l'onglet m
            Next i 'prochain décalage d'une celllule vers la droite
        End If 'fin de la condition 2
        Set r1 = plm.Find(ca, r1, xlValues, xlWhole) 'redéfinit la recherche r (occurrence suivante)
    Loop While Not r1 Is Nothing And r1.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
End If 'fin de la condition 1
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
272
Réponses
7
Affichages
626
Réponses
33
Affichages
3 K
  • Question Question
Microsoft 365 macro vba sumifs
Réponses
5
Affichages
629
  • Question Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
695
Réponses
1
Affichages
1 K
Retour