Somme conditionnelle par macro

[chrisdu73]

Bonjour les amis,
Après de multitude recherches je n'arrive pas à trouver.
Toujours avec le même fichier, je n'arrive pas a faire un regroupement sur les champs A et sur le champs B pour faire une somme de F.
Avec une macro car j'aurai un autre traitement à faire par la suite.
Le résultat serai comme en Feuil1 dans le fichier
encore merci de votre aide

 

[jp14]

Re : Somme conditionnelle par macro

Bonjour

Ci dessous un code qui devrait répondre au problème

Sub travdem()
Dim Nomfeuille1 As String
Dim Col As String
Dim Dl1 As Long, I As Long, J As Long, Dl2 As Long
Dim Data1 As String
Dim Date1 As Date, Date2 As Date
Dim Duree1 As Currency
Dim Cel As Range

'parametre
' pour boucler sur la colonne 1
Nomfeuille1 = "Export WorkSheet"
Col = "b"
With Sheets(Nomfeuille1)

Dl1 = .Range(Col & .Rows.Count).End(xlUp).Row
For I = 2 To Dl1
        Set Cel = .Range(Col & I)
        Data1 = Cel
        Date1 = Cel.Offset(0, 2)
        Duree1 = CCur(Cel.Offset(0, 4))
        J = 1
    Do
        If Cel.Offset(J, 0) = Cel Then
            Date2 = Cel.Offset(J, 2)
            Duree1 = CCur(Cel.Offset(J, 4)) + Duree1
            I = I + 1
        Else
            Exit Do
        End If
        J = J + 1
    Loop
    
        Dl2 = Sheets(Nomfeuille1).Range(Col & Sheets(Nomfeuille1).Rows.Count).End(xlUp).Row + 1
        Sheets(Nomfeuille1).Range("a" & Dl2) = Cel.Offset(0, -1)
        Sheets(Nomfeuille1).Range("b" & Dl2) = Cel
        Sheets(Nomfeuille1).Range("c" & Dl2) = Date1
        Sheets(Nomfeuille1).Range("d" & Dl2) = Date2
        Sheets(Nomfeuille1).Range("e" & Dl2) = CSng(Duree1)
Next I

End With

'
End Sub

A tester et à modifier.

J'utilise CCUR pour éviter les problèmes d'arrondi.

JP

 

[chrisdu73]

Re : Somme conditionnelle par macro

Cool jp14, ca fonctionne, mais juste savoir comment mettre le résultat sur une autre feuil ?
C'est tout simplement génial.
Merci encore

 

[Robert]

Re : Somme conditionnelle par macro

Bonjour Chris, JP, bonjour le forum,

Puisque j'y ai planché dessus je t'envoie aussi ma proposition avec le code ci-dessous:

Option Explicit 'oblige à déclarer toutes les variables

Sub Macro1()
Dim dl As Integer 'déclare la variable dl(Dernière Ligne)
Dim x As Integer 'déclare la varialbe x
Dim tot As Double 'déclare la variable tot (TOTal)
Dim i As Integer 'déclare la variable i (Incrément)
Dim li As Integer 'déclare la variable li (Ligne)
Dim cel As Range 'déclare la variable cel (CELlule)

With Sheets("Export Worksheet") 'prend en compte l'onglet "Export Worksheet"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl
    For x = 2 To dl 'boucle sur les ligne x à dl
        tot = 0 'réinitialise la variable tot
        i = 0 'réinitialise l'incrément i
        li = Sheets("Feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la ligne li
        Sheets("Feuil1").Cells(li, 1).Value = .Cells(x, 1).Value 'récupère le "NUM"
        Sheets("Feuil1").Cells(li, 2).Value = .Cells(x, 2).Value 'récupère le "CODE"
        Sheets("Feuil1").Cells(li, 3).Value = .Cells(x, 4).Value 'récupère la "DATE_VALEUR"
        .Range("A1").AutoFilter field:=1, Criteria1:=.Cells(x, 1).Value 'filtre automatique de l'onglet sur la colonne A, critère : cellule Ax
        .Range("A1").AutoFilter field:=2, Criteria1:=.Cells(x, 2).Value 'filtre automatique de l'onglet sur la colonne B, critère : cellule Bx
        Sheets("Feuil1").Cells(li, 4).Value = .Cells(Application.Rows.Count, 4).End(xlUp).Value 'récupère la dernière "DATE_VALEUR"
        For Each cel In .Range("F2:F" & .Cells(Application.Rows.Count, 4).End(xlUp).Row).SpecialCells(xlCellTypeVisible) 'boucle sur toutes les cellules visibles de la colonne F
            tot = tot + CDbl(cel.Value) 'définit le total tot
            i = i + 1 'incrément i
        Next cel 'prochaine cellule de la boucle
        Sheets("Feuil1").Cells(li, 5).Value = tot 'récupère le total tot
        .Range("A1").AutoFilter 'supprime le filtre automatique
        x = x + (i - 1) 'incrémente x pour passer au prochain code
    Next x 'prochain ligne de la boucle
End With 'fin de la prise en compte de l'onglet "Export Worksheet"
End Sub

Le fichier :

 

[jp14]

Re : Somme conditionnelle par macro

Bonjour
Salut Robert

Cool jp14, ca fonctionne, mais juste savoir comment mettre le résultat sur une autre feuil ?
C'est tout simplement génial.
Merci encore

Il faut modifier le code suivant

      Dl2 = Sheets(nom de la feuille ).Range(Col & Sheets(nom de la feuille).Rows.Count).End(xlUp).Row + 1
        Sheets(nom de la feuille).Range("a" & Dl2) = Cel.Offset(0, -1)
        Sheets(nom de la feuille).Range("b" & Dl2) = Cel
        Sheets(nom de la feuille).Range("c" & Dl2) = Date1
        Sheets(nom de la feuille).Range("d" & Dl2) = Date2
        Sheets(nom de la feuille).Range("e" & Dl2) = CSng(Duree1)

JP

 

[chrisdu73]

Re : Somme conditionnelle par macro

Robert tu est un chef,
Merci à vous deux et grâce à tes commentaires je comprend mieux le déroulement de la macro.
j'en profite aussi pour vous demander:
Sur la feuille 'Export' quand il se produit une rupture de date en D sur les codes identique en A et B comme sur les lignes 23 à 25, la date passe du 25/11/2011 au 29/11/2011,
j'aurai voulu insérer des lignes identique à la ligne du dessus mais avec une valeur à 0 en F

merci encore

 

[Robert]

Re : Somme conditionnelle par macro

Bonsoir le fil, bonsoir le forum,

Je n'a pas compris où tu voulais inserer les lignes. Dans l'onglet Feuil1 ou dans l'onglet Export Worksheet ?

 

[chrisdu73]

Re : Somme conditionnelle par macro

Merci jp14, ça marche impeccable pour ma première demande, juste un souci avec ma deuxième demande

 

[chrisdu73]

Re : Somme conditionnelle par macro

Bonsoir le fil, bonsoir le forum,

Je n'a pas compris où tu voulais inserer les lignes. Dans l'onglet Feuil1 ou dans l'onglet Export Worksheet ?

dans le fichier export