Rupture Avec Total

Bonjour!

Je vous sollicite pour une aide concernant le calcul d'un total de la quantité colonne B "Par Lot" colonne A.

Je vous joins mon classeur. Merci a tous

Cordialement

49essai-forum-ep.xlsx (25.15 Ko)

Salut,

Essaye avec un tableau croisé dynamique.

Bonjour Hosni, toutes et tous,

Voir si cela convient.

Cordialement.

Bonjour!

D'abord je vous remercie tout deux pour vo réponses respective, lauange, j'ai déjà mis en place le TCD et cela marche très bien.

pour la réponse de mdo100 elle répond à mes attentes main en partie.

Le total doit se faire sur le même tableau à la fin de chaque lot, peut être un tri par ordre croissant est indispensable avant le total de chaque lot. J'ai mis un exemple sur la feuille Plus Nourrisson

Bonjour,

Une proposition.

Cdlt.

Re à toutes et tous,

Bien vu Jean-Eric, efficace et rapide, mais je ne maitrise absolument pas les TCDs.

Du coup merci à eriiic, pour le lien que j'ai mis sous le coude, car, il va bien falloir que je m'y mette un jour.

Cordialement.

Bonsoir à tous!

Je vous remercie pour vos réponses elles sont toutes bénéfiques pour moi du moment que j’apprends avec plus.

Toute fois j'aurai aimer une solution qui correspond exactement à mon exemple.

Merci à tous.

Tu as suivi le lien que je t'ai fourni ?

C'est justement pour insérer un sous-total sur une rupture de champ.

Bonjour,

Pour la solution proposée précédemment, la mise sous forme de tableau n'est pas adaptée, il faut convertir le tableau en plage.

Cdlt.

Oui je sais.

C'est pourquoi j'ai mis le lien qui l'expliquait plutôt que l'indication de l'outil qui dans ce contexte est absent.

Bonjour!

Merci à vous eriiic, votre solution est parfaite, je vais reprendre le sujet et vous donner des nouvelles ce soir. Merci encore.

Cordialement.

Bonsoir!

Je reviens sur mon sujet avec une complication en plus. Je reprend mon classeur initialement posté et vous demande de l'aide pour un total par Client et Num de Lot, sachant qu'un lot peut se trouver chez plus d'un client à la fois.

Mes connaissance en VB sont limitées car je pense qu'une Macro serait radical pour le tri et le total à la fois.

Merci à tous.

Cordialement.

Bonjour,

Un exemple avec un tableau croisé dynamique.

Cdlt.

Bonsoir!

Merci à vous Jean-Eric, je vais me limiter à votre réponse. Merci encore

Cordialement.

Bonsoir le fil

Pour l'exercice :

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, e, v, x, y
    With Sheets("Nourrisson").Range("a1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                    .Item(a(i, 1)).CompareMode = 1
                End If
                If Not .Item(a(i, 1)).exists(a(i, 3)) Then
                    ReDim w(1 To 3, 1 To 2)
                Else
                    w = .Item(a(i, 1))(a(i, 3))
                    ReDim Preserve w(1 To 3, 1 To UBound(w, 2) + 1)
                End If
                For j = 1 To UBound(a, 2)
                    w(j, UBound(w, 2) - 1) = a(i, j)
                Next
                .Item(a(i, 1))(a(i, 3)) = w
            Next
            For Each e In .keys
                For Each v In .Item(e).keys
                    w = .Item(e)(v)
                    w(1, UBound(w, 2)) = "Total " & v & " " & e
                    w(2, UBound(w, 2)) = Application.Sum(Application.Index(w, 2, Evaluate("row(1:" & UBound(w, 2) - 1 & ")")))
                    .Item(e)(v) = w
                Next
            Next
            x = .keys: y = .items
        End With
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1).Resize(1, 3)
            .CurrentRegion.Clear
            .Value = Array("Numéro Lot", "Quantité", "Clients")
            n = 2
            For i = 0 To UBound(x)
                For j = 0 To y(i).Count - 1
                    'w = y(i).items()(j)
                    '.Cells(n).Resize(UBound(w, 2), 3).Value = Application.Transpose(Application.Index(w, 0, 0))
                    With .Cells(n, 1).Resize(UBound(y(i).items()(j), 2), 3)
                        .Value = Application.Transpose(Application.Index(y(i).items()(j), 0, 0))
                        .BorderAround Weight:=xlThin
                    End With
                    With .Cells(n + UBound(y(i).items()(j), 2) - 1, 1).Resize(, 2)
                        .Interior.ColorIndex = 40
                        .BorderAround Weight:=xlThin
                    End With
                    n = n + UBound(y(i).items()(j), 2)
                Next
            Next
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                With .Rows(1)
                    .Font.Size = 11
                    .Interior.ColorIndex = 19
                    .BorderAround Weight:=xlThin
                    .HorizontalAlignment = xlCenter
                End With
                .Columns.AutoFit
            End With
        End With
        .Parent.Activate
        Application.ScreenUpdating = True
    End With
End Sub

klin89

Bonsoir!

Merci à vous Klin89, votre réponse apporte de l'eau à mon moulin. Merci encore. Serait il possible d'avoir un tri sur la colonne client?

Cordialement.

Re Hosni,

Ai je bien compris

Je n'ai pas testé.

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, e, v, x, y
    With Sheets("Nourrisson").Range("a1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 3)) Then
                    Set .Item(a(i, 3)) = CreateObject("Scripting.Dictionary")
                    .Item(a(i, 3)).CompareMode = 1
                End If
                If Not .Item(a(i, 3)).exists(a(i, 1)) Then
                    ReDim w(1 To 3, 1 To 2)
                Else
                    w = .Item(a(i, 3))(a(i, 1))
                    ReDim Preserve w(1 To 3, 1 To UBound(w, 2) + 1)
                End If
                w(1, UBound(w, 2) - 1) = a(i, 3)
                w(2, UBound(w, 2) - 1) = a(i, 2)
                w(3, UBound(w, 2) - 1) = a(i, 1)
                .Item(a(i, 3))(a(i, 1)) = w
            Next
            For Each e In .keys
                For Each v In .Item(e).keys
                    w = .Item(e)(v)
                    w(1, UBound(w, 2)) = "Total " & e & " " & v
                    w(2, UBound(w, 2)) = Application.Sum(Application.Index(w, 2, Evaluate("row(1:" & UBound(w, 2) - 1 & ")")))
                    .Item(e)(v) = w
                Next
            Next
            x = .keys: y = .items
        End With
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1).Resize(1, 3)
            .CurrentRegion.Clear
            .Value = Array("Clients", "Quantité", "Numéro Lot")
            n = 2
            For i = 0 To UBound(x)
                For j = 0 To y(i).Count - 1
                    'w = y(i).items()(j)
                    '.Cells(n).Resize(UBound(w, 2), 3).Value = Application.Transpose(Application.Index(w, 0, 0))
                    With .Cells(n, 1).Resize(UBound(y(i).items()(j), 2), 3)
                        .Value = Application.Transpose(Application.Index(y(i).items()(j), 0, 0))
                        .BorderAround Weight:=xlThin
                    End With
                    With .Cells(n + UBound(y(i).items()(j), 2) - 1, 1).Resize(, 2)
                        .Interior.ColorIndex = 40
                        .BorderAround Weight:=xlThin
                    End With
                    n = n + UBound(y(i).items()(j), 2)
                Next
            Next
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                With .Rows(1)
                    .Font.Size = 11
                    .Interior.ColorIndex = 19
                    .BorderAround Weight:=xlThin
                    .HorizontalAlignment = xlCenter
                End With
                .Columns.AutoFit
            End With
        End With
        .Parent.Activate
        Application.ScreenUpdating = True
    End With
End Sub

klin89

Rechercher des sujets similaires à "rupture total"