XL 2016 groupement+ total et sous total

[USER2112]

Bonjour,
s'il vous plait quelqu'un peut m'aider?
je veut regrouper automatiquement avec une macro les lignes du fichier joint par clients ainsi insérer une ligne après chaque groupement pour afficher la somme des revenues de chaque client, par contre j'aimerais bien insérer une autre ligne en dessus de cette ligne si timbre = vrais pour chaque client autrement dis pour chaque clients je veut calculer la somme de ces revenues (somme revenu par livraison + timbre =500).
par exemple un client A a livrer BL1,BL2, BL3de montant successif 15000, 2000 et 13 000 avec timbre= vrai je veut une ligne en dessous du regroupement timbre = 500 (si timbre = vrai) et une autre ligne en dessous Total revenu = timbre+ 15000+2000+13000= 30500

 

[USER2112]

bonjour,
personne ne peut m'aider,
vraiment je suis bloqué

 

[chris]

Bonjour
Il y a une ambigüité entre ton énoncé et ton exemple : certains client ont des lignes avec timbre=vrai et d'autres non or ton énoncé semble indiquer 500 par client et non par ligne.

Peux-tu préciser...

 

[USER2112]

bonjour,
en fait et pour plus de précision c'est une relevé de facture (liste des bls avec total = somme des montant des bl's + timbre si applicable pour ce client sinon total= somme des montants des bls sans ajouter un timbre). merci de regarder l'exemple en PJ

 

[chris]

Re

Ci-joint un classeur qui propose 3 solutions, un peu différentes de ton modèle mais ne nécessitant pas de VBA.

 

[USER2112]

Merci pour l exemple mais je veut que la tâche se fasse automatiquement avec une macro

 

[USER2112]

Merci pour l aide malheureusement je veut automatiser la tâche avec une macro

 

[klin89]

Bonsoir le forum

A tester sur le fichier du post #1#

Option Explicit
Sub test()
Dim dico As Object, i As Long, n As Long, txt As String, e
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1").Range("a6").CurrentRegion
        For i = 2 To .Rows.Count
            txt = .Rows(i).Cells(2).Value & ";" & .Rows(i).Cells(9).Value
            If i = 2 Then
                Set dico(txt) = .Rows(1)
            End If
            If Not dico.exists(txt) Then
                Set dico(txt) = .Rows(i)
            Else
                Set dico(txt) = Union(dico(txt), .Rows(i))
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil2")
        .Cells.Clear
        For Each e In dico
            n = n + 1
            dico(e).Copy .Cells(n, 1)
            Application.DisplayAlerts = False
            With .Cells(n, 1).CurrentRegion
                If n = 1 Then n = 2
                If UCase(.Cells(n, 9)) = "FAUX" Then
                    With .Offset(.Rows.Count).Resize(1)
                        .Cells(1) = "Total facture"
                        .Cells(11) = "=sum(r" & n & "c:r[-1]c)"
                    End With
                    With .Range(.Cells(n, 1), .Cells(.Rows.Count, 1))
                        .Merge
                        With .Resize(, 2)
                            .VerticalAlignment = xlCenter
                            .Interior.ColorIndex = 43
                        End With
                    End With
                    With .Range(.Cells(n, 2), .Cells(.Rows.Count, 2))
                        .Merge
                    End With
                    n = .Rows.Count + 1
                Else
                    With .Offset(.Rows.Count).Resize(1)
                        .Cells(1) = "Timbre"
                        .Cells(11) = 500
                        .Cells(1).Offset(1) = "Total facture"
                        .Cells(11).Offset(1) = "=sum(r" & n & "c:r[-1]c)"
                    End With
                    With .Range(.Cells(n, 1), .Cells(.Rows.Count, 1))
                        .Merge
                        With .Resize(, 2)
                            .VerticalAlignment = xlCenter
                            .Interior.ColorIndex = 37
                        End With
                    End With
                    With .Range(.Cells(n, 2), .Cells(.Rows.Count, 2))
                        .Merge
                    End With
                    n = .Rows.Count + 2
                End If
            End With
            Application.DisplayAlerts = True
        Next
        .Cells(1).CurrentRegion.Rows(1).Interior.ColorIndex = 38
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89

 

[USER2112]

bonjour,
rien ne change