Rupture Avec Total Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
eriiic
Passionné d'Excel
Passionné d'Excel
Messages : 9'135
Appréciations reçues : 349
Inscrit le : 7 février 2010
Version d'Excel : 2010fr

Message par eriiic » 15 novembre 2016, 10:02

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.
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.
(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
Avatar du membre
Hosni
Membre dévoué
Membre dévoué
Messages : 811
Inscrit le : 24 septembre 2011
Version d'Excel : 2013/2016

Message par Hosni » 15 novembre 2016, 12:27

Bonjour!
Merci à vous eriiic, votre solution est parfaite, je vais reprendre le sujet et vous donner des nouvelles ce soir. Merci encore.
Cordialement.
La vie est une École, qui nous apprend tous les jours plus..., Plus on sait..., Moins on en sait...
B. Hosni
Avatar du membre
Hosni
Membre dévoué
Membre dévoué
Messages : 811
Inscrit le : 24 septembre 2011
Version d'Excel : 2013/2016

Message par Hosni » 16 novembre 2016, 20:50

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.
Essai Forum EP.xlsx
(26.62 Kio) Téléchargé 6 fois
La vie est une École, qui nous apprend tous les jours plus..., Plus on sait..., Moins on en sait...
B. Hosni
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 15'605
Appréciations reçues : 564
Inscrit le : 27 août 2012
Version d'Excel : 365 Insider

Message par Jean-Eric » 16 novembre 2016, 22:16

Bonjour,
Un exemple avec un tableau croisé dynamique.
Cdlt.
Essai Forum EP.xlsx
(41.23 Kio) Téléchargé 6 fois
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Hosni
Membre dévoué
Membre dévoué
Messages : 811
Inscrit le : 24 septembre 2011
Version d'Excel : 2013/2016

Message par Hosni » 17 novembre 2016, 00:08

Bonsoir!
Merci à vous Jean-Eric, je vais me limiter à votre réponse. Merci encore
Cordialement.
La vie est une École, qui nous apprend tous les jours plus..., Plus on sait..., Moins on en sait...
B. Hosni
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 17 novembre 2016, 21:21

Bonsoir le fil :D

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
Avatar du membre
Hosni
Membre dévoué
Membre dévoué
Messages : 811
Inscrit le : 24 septembre 2011
Version d'Excel : 2013/2016

Message par Hosni » 17 novembre 2016, 22:44

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.
La vie est une École, qui nous apprend tous les jours plus..., Plus on sait..., Moins on en sait...
B. Hosni
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 18 novembre 2016, 12:24

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message