1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2013 Regroupement de données selon plusieurs critères..

Discussion dans 'Forum Excel' démarrée par anri0610, 6 Août 2018.

  1. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    25769
    "J'aime" reçus :
    2191
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Le bug vient certainement du fait que votre version Excel est une version anglaise, vous auriez pu nous le dire.

    Il faut donc entrer les formules de la MFC dans une cellule et récupérer les FormulaLocal pour fonctionner sous toute version :
    Code (Text):
    Sub Grouper()
    Dim dest As Range, t, ub&, a(), i&, k%, n&, x$, j&
    Application.ScreenUpdating = False
    With ActiveSheet 'si la macro est dans un autre fichier
        Set dest = .[G1] '1ère cellule des résultats, à adapter
        t = .[A1].CurrentRegion.Resize(, 5) '5 colonnes
        ub = UBound(t)
        ReDim a(1 To ub * (UBound(t, 2) + 1), 1 To 2) '2 colonnes
        For i = 2 To ub
            n = n + 1 '1 ligne de séparation
            x = t(i, 2) & t(i, 3) & t(i, 4)
            For k = 1 To 5
                n = n + 1: a(n, 1) = t(1, k): a(n, 2) = t(i, k)
            Next k
            For j = i + 1 To ub
                If t(j, 2) & t(j, 3) & t(j, 4) <> x Then Exit For
                If t(j, 1) <> t(j - 1, 1) Then a(n - 4, 2) = a(n - 4, 2) & "." & t(j, 1)
                a(n, 2) = a(n, 2) + t(j, 5)
            Next j
            i = j - 1
        Next i
        With dest
            If n Then
                With dest(1, 2)
                    '---copie de la 1ère condition de la MFC---
                    .Parent.[A2].Copy
                    .Resize(n).PasteSpecial xlPasteFormats 'collage spécial
                    Application.CutCopyMode = 0
                    '---2ème condition de la MFC---
                    .Formula = "=AND(MOD(ROW()-ROW(" & .Address & "),6)=3," & .Address(0) & ">25)"
                    .Resize(n).FormatConditions.Add(Type:=xlExpression, Formula1:=.FormulaLocal).Font.Color = vbRed 'police rouge
                    '---3ème condition de la MFC---
                    .Formula = "=AND(MOD(ROW()-ROW(" & .Address & "),6)=5," & .Address(0) & "<=5)"
                    With .Resize(n).FormatConditions.Add(Type:=xlExpression, Formula1:=.FormulaLocal)
                        .Font.Color = vbRed: .Font.Bold = True 'police rouge gras
                    End With
                End With
                .Resize(n, 2) = a 'restitution du tableau
            End If
            .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).Clear 'RAZ en dessous
            .Resize(, 2).EntireColumn.AutoFit 'ajustement largeur
        End With
        Application.GoTo .[A1], True 'cadrage
        With .UsedRange: End With 'actualise la barre de défilement verticale
    End With
    End Sub
    Comme vous pouvez le voir la cellule dest est maintenant G1 et j'ai introduit une ligne de séparation.

    Edit : bah j'avais oublié d'ajouter 1 à UBound(t, 2) pour le dimensionnement du tableau a.

    Fichier (4).

    A+
     

    Pièces jointes:

    Dernière édition: 10 Août 2018
  2. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    teste et approuve et enregistrer cela fonctionne parfaitement merci!
    reste seulement les deux derniers soucis évoques précédemment !

    oui tout a fait c'est ma faute , je ne savais seulement pas ce qu'il aurait été important de préciser !
    j'ai modifier mon profil et je ferait attention a l'avenir merci pour la remarque .
     
  3. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour.
    1. Il ne peut pas y avoir me semble t-il de doublon du critère de la 1ere colonne: ils sont tous cumulés. Donc l'ex= 301.301.307.308 ne peut pas apparaître. Le 3ième non plus AW-1.AD-1.AW-2.AD-2 ce sera obligatoirement AD-1.AD-2.AW-1.AW-2. J'ai ajouter du code pour ne plus répéter les préfixes identiques spécifiés devant un "-"
    2. Il suffisait de déplacer le LR = LR + 1 juste avant le Next Arg2
    Le tout pour la partie qui est de moi donne ça :
    Code (Visual Basic):
       Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, TTit(), RngCbl As Range, _
          TJoin() As String, J As Long, RngPoliceRg As Range, PfxArg As String, P As Long
       TTit = ActiveSheet.[A1:E1].Value
       ReDim TR(1 To 100000, 1 To 3)
       Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
       RngCbl.Font.Color = 0
       For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -4, -3, 1)
          For Each Arg4 In Arg2.Co
             For Each Arg3 In Arg4.Co
                ReDim TJoin(1 To Arg3.Count): J = 0
                For Each Arg1 In Arg3.Co: J = J + 1: TJoin(J) = Arg1.Id: Next Arg1
                PfxArg = "?"
                For J = 1 To UBound(TJoin)
                   P = InStr(TJoin(J), "-")
                   If Left$(TJoin(J), P) = PfxArg Then TJoin(J) = Mid$(TJoin(J), P + 1) Else PfxArg = Left$(TJoin(J), P)
                   Next J
                LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
                LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5): If Arg4.Somme(5) <= 5 Then TR(LR, 3) = 1
                Next Arg3, Arg4
          LR = LR + 1: Next Arg2
       RngCbl.Value = TR
       On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
       If Err = 0 Then
          RngCbl.Offset(, -1).Font.Color = &HFF&
          RngCbl.ClearContents: End If
    Remarque: il me semble absurde d'ajouter chaque fois une copie de la mise en forme conditionnelle sur la colonne H. Vous en voudrez combien comme ça, des centaines ?
     
    Dernière édition: 10 Août 2018
  4. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Tout est complètement parfait ! Je vous remercie infiniment !!!
    je ne saurait comment vous remercier (a tous) a mon niveau je n'y serait jamais arriver seul !

    ps= je n'ai pas compris votre remarque ..
     
  5. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Alez voir du coté des mise en formes conditionnelles, vous verrez… A chaque exécution vous en ajoutez une qui existe déjà sur la colonne H. C'est du moins comme ça dans votre dernier PERSONAL.xlsm joint.
     
  6. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    25769
    "J'aime" reçus :
    2191
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Elle est dû au fait que Bernard n'utilise pas de MFC pour la police en rouge.
     
  7. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    25769
    "J'aime" reçus :
    2191
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Pour la dernière demande :
    voyez ce fichier (5) et la macro :
    Code (Text):
    Sub Grouper()
    Dim dest As Range, t, ub&, a(), i&, k%, n&, x$, j&
    Application.ScreenUpdating = False
    With ActiveSheet 'si la macro est dans un autre fichier
        Set dest = .[G1] '1ère cellule des résultats, à adapter
        t = .[A1].CurrentRegion.Resize(, 5) '5 colonnes
        ub = UBound(t)
        ReDim a(1 To ub * (UBound(t, 2) + 1), 1 To 2) '2 colonnes
        For i = 2 To ub
            If t(i, 2) <> t(i - 1, 2) Then n = n + 1 '1 ligne de séparation
            x = t(i, 2) & t(i, 3) & t(i, 4)
            For k = 1 To 5
                n = n + 1: a(n, 1) = t(1, k): a(n, 2) = t(i, k)
            Next k
            For j = i + 1 To ub
                If t(j, 2) & t(j, 3) & t(j, 4) <> x Then Exit For
                If t(j, 1) <> t(j - 1, 1) Then a(n - 4, 2) = a(n - 4, 2) & "." & t(j, 1)
                a(n, 2) = a(n, 2) + t(j, 5)
            Next j
            i = j - 1
        Next i
        With dest
            If n Then
                With dest(1, 2)
                    '---copie de la 1ère condition de la MFC---
                    .Parent.[A2].Copy
                    .Resize(n).PasteSpecial xlPasteFormats 'collage spécial
                    Application.CutCopyMode = 0
                    '---2ème condition de la MFC---
                    .Resize(n).FormatConditions.Add(Type:=xlExpression, _
                        Formula1:="=(" & dest.Address(0) & "=$C$1)*(" & .Address(0) & ">25)").Font.Color = vbRed 'police rouge
                    '---3ème condition de la MFC---
                    With .Resize(n).FormatConditions.Add(Type:=xlExpression, Formula1:="=(" & dest.Address(0) & "=$E$1)*(" & .Address(0) & "<=5)")
                        .Font.Color = vbRed: .Font.Bold = True 'police rouge gras
                    End With
                End With
                .Resize(n, 2) = a 'restitution du tableau
            End If
            .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).Clear 'RAZ en dessous
            .Resize(, 2).EntireColumn.AutoFit 'ajustement largeur
        End With
        Application.GoTo .[A1], True 'cadrage
        With .UsedRange: End With 'actualise la barre de défilement verticale
    End With
    End Sub
    Les formules de la MFC font maintenant référence aux titres en colonne G et pas aux numéros de lignes, elles sont valables sur toute version.

    A+
     

    Pièces jointes:

  8. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour merci , cela fonctionne super !
    par contre depuis ce matin j'ai un petit soucis j'ai opter pour un filtrage des données de colonnes en ordre non plus B>D>C mais maintenant B>C>D,
    comme ci dessous:
    Code (Visual Basic):
            Columns("A:E").Select
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range( _
            "B1:B1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        ActiveSheet.Sort.SortFields.Add Key:=Range( _
            "C1:C1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        ActiveSheet.Sort.SortFields.Add Key:=Range( _
            "D1:D1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("A1:E1000")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
     
    jusque la pas de soucis,
    seulement au moment du regroupement via gigogne regrouper ou bien encore la macro grouper de Job75,
    je n'obtient plus le même ordre dans les résultats et ça se mélange, je voudrais garder l'ordre de regroupement des données dans l'ordre des colonnes B>C>D,
    pourriez vous me dire ce qu'il faudrait modifier ? (j'ai chercher a comprendre mais je n'ai pas trouver ni dans les macro ni dans Mgigogne..)
    je vous joint les fichiers.

    (veuillez m'excuser pour la réponse tardive , j'etait en repos et je n'ai pas réussi a installer office sur mon mac..avec la License du travail ><
    pourriez vous me dire comment vous remercier pour tous vos efforts ! peut être un don ou je ne saurais )
     

    Pièces jointes:

  9. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour
    Pour Gigogne c'est l'ordre des numéros de colonnes spécifiés derrière (en négatif pour un classement en ordre décroissant).
    Attention: l'ordre d'imbrication des boucles sur les SsGr doit être corrigé en conséquence.
    Le classement des données n'est pas nécessaire, toutefois pour un très gros volume de données il peut accélérer le traitement.
     
  10. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    bonjour,
    merci!
    j'ai essayer et chercher plusieurs choses mais je n'ai trouver que l'ordre des données..
    Code (Visual Basic):
       For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -4, -3, 1)
     
    pourriez vous m’éclairer pour modifier gigogne et SsGr?
     
  11. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour.
    Il n'y a rien à modifier dans la programmation de service. Juste dans votre procédure applicative mettre à la place :
    Code (Text):
     For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -3, -4, 1)
    Et corriger en conséquence l'ordre d'imbrication des boucles qui suivent :
    For Each Arg3 In Arg2.Co … For Each Arg4 In Arg3.Co … For Each Arg1 In Arg4.Co … Next Arg1 … Next Arg4 … Next Arg3 … Next Arg2
     
  12. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour merci !
    voici l'erreur que j'obtient,

    Code (Visual Basic):
       For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -4, -3, 1)
          For Each Arg3 In Arg2.Co
             For Each Arg4 In Arg3.Co
                ReDim TJoin(1 To Arg3.Count): j = 0
                For Each Arg1 In Arg4.Co: j = j + 1[COLOR=#ff4d4d]: TJoin(j) = Arg1.Id[/COLOR]: Next Arg1
                PfxArg = "?"
                For j = 1 To UBound(TJoin)
                   P = InStr(TJoin(j), "-")
                   If Left$(TJoin(j), P) = PfxArg Then TJoin(j) = Mid$(TJoin(j), P + 1) Else PfxArg = Left$(TJoin(j), P)
                   Next j
                LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
                LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5): If Arg4.Somme(5) <= 5 Then TR(LR, 3) = 1
                Next Arg4, Arg3
          LR = LR + 5: Next Arg2
       RngCbl.Value = TR
       On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
       If Err = 0 Then
          RngCbl.Offset(, -1).Font.Color = &HFF&
          RngCbl.ClearContents: End If
     
     

    Pièces jointes:

  13. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour.
    Vous n'avez pas dit quelle erreur c'est, justement, mais ça doit être un indice en dehors des limites parce que vous avez dimensionné TJoin selon le nombre d'Arg4 dans Arg3 au lieu du nombre d'Arg1 dans Arg4. Ça doit être :
    Code (Visual Basic):
             ReDim TJoin(1 To Arg4.Count): J = 0
    Mais il y a plus grave : Vous avez laissé les numéros de colonnes -2, -4, -3, 1 à l'appel de Gigogne au lieu de mettre -2, -3, -4, 1
    Il se peut que ça ne plante pas, mais ça va intervertir les valeurs de la colonne 4 dans les Arg3.Id et celles de la 3 dans les Arg4.Id sans donner à cette colonne 3 la priorité sur la 4 du classement et du regroupement.
     
    Dernière édition: 28 Août 2018
  14. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour,
    encore une fois Merci beaucoup Dranreb ! c'est parfait ça fonctionne !
     
  15. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour,
    Dranreb je souhaiterai effectuer un petit ajout au module regrouper,
    j'ai effectuer quelques améliorations depuis et je souhaiterai a présent pour ligne de données ajouter une information présente dans la colonne qui suit (colonneF),
    et la faire apparaître dans la colonne I a la droite de la somme .
    (les données présentes dans cette nouvelle colonne correspondent a la couleur du produit)
    pourriez vous m aider s'il vous plait!?

    ce n 'est d'aucune aide je pense mais j'ai tenter désespérément de modifier le code moi-même en essayant d'ajouter un Arg5 :

    Code (Visual Basic):
       Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, Arg5 As SsGr, TTit(), RngCbl As Range, _
          TJoin() As String, j As Long, RngPoliceRg As Range, PfxArg As String, P As Long
       TTit = ActiveSheet.[A1:F1].Value
       ReDim TR(1 To 100000, 1 To 3)
       Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
       RngCbl.Font.Color = 0
       For Each Arg2 In Gigogne(ActiveSheet.[A2:F2], -2, -3, -4, 1, -5)
          For Each Arg3 In Arg2.Co
             For Each Arg4 In Arg3.Co
                      For Each Arg5 In Arg4.Co

                ReDim TJoin(1 To Arg4.Count): j = 0
                For Each Arg1 In Arg4.Co: j = j + 1: TJoin(j) = Arg1.Id: Next Arg1
                PfxArg = "?"
                For j = 1 To UBound(TJoin)
                   P = InStr(TJoin(j), "-")
                   If Left$(TJoin(j), P) = PfxArg Then TJoin(j) = Mid$(TJoin(j), P + 1) Else PfxArg = Left$(TJoin(j), P)
                   Next j
                LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
                LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5): If Arg4.Somme(5) <= 5 Then TR(LR, 3) = 1
                Next Arg5, Arg4, Arg3
          LR = LR + 5: Next Arg2
       RngCbl.Value = TR
       On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
       If Err = 0 Then
          RngCbl.Offset(, -1).Font.Color = &HFF&
          RngCbl.ClearContents: End If
     
     

    Pièces jointes:

  16. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Je souhaiterai au moins vous poser la question pour savoir si seulement c est possible..
    etant donner que ce serait l'ideal pour que votre outil soit applicable complètement dans mon cas ,
    je vais essayer d’être clair,

    Dans L'ordre des données de la colonne F définir pour chaque valeur (nom de couleur) identique une référence interne qui donnerai couleur1, couleur2 etc.
    pour ensuite modifier le placement de la somme pour chaque ligne, ce qui donnerai pour couleur1, toujours le placement en -4, si couleur2 existe le placement en -5, si couleur 3 existe en -6 etc
    ce qui laisserait des espaces entre les valeur d'une même ligne , ce qui est exactement le but rechercher !
    je souhaiterai savoir si ce serait possible d'en demander autant.
    merci bien !
     

    Pièces jointes:

  17. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour.
    Je ne comprends pas bien ce que vous voulez.
    Déjà la colonne F c'est la 6, pas la 5. Et vous voudriez aussi un classement en ordre décroissant et un regroupement dessus ? Et dans ce cas ne devrait-il pas venir avant le dernier regroupement sur la colonne 1 ? C'est d'ailleurs ce que semble indiquer l'imbrication de vos boucles.
    En général je n'appelle pas mes SsGr Arg1, Arg2 etc. Je leur donne des noms en rapport avec les titres des colonnes. Mais là c'est du japonais, alors… Pour rester dans la logique appelez Arg6 un SsGr pour la colonne 6.
    Qu'est ce que vous appelez le placement ?
     
  18. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour Dranreb,
    je souhaiterai le résultat que j'ai joint en print screen,

    mon premier message=

    je souhaiterai seulement indiquer la reference couleur a droite de la somme via Mregrouper
    (pour chaque ligne regroupée, de manière a ne pas faire la somme et mélanger des couleurs différentes)
    pour ensuite faire le tri manuellement.

    mon deuxième message=

    je souhaiterai avoir un regroupement avec comme dernière règle de regroupement les données de cette colonne F,
    en identifiant le nombre de couleur présentes dans le fichier traiter , de par le nombre de "nom de couleur" différents peut etre,
    pour ensuite placer selon la couleur, la somme de regroupement actuelle.
    Cette position serait dans le cas de la couleur 1, a la position actuelle en 5 en dessous des données de la colonne D.
    Dans le cas d'une couleur 2, -1 en dessous , donc en 6 en laissant 1 espace entre les données de la colonne D et la somme.
    Dans le cas d'une couleur 3, -2 en dessous, donc en 7 en laissant 2 espace entre les données de la colonne D et la somme.
    Dans le cas d'une couleur 4, -3 en dessous, donc en 7 en laissant 2 espace entre les données de la colonne D et la somme.
    etc
    puis toujours si seulement c'est possible,
    si pour un regroupement nous avons toutes les mêmes données, (donc jusqu’à maintenant un regroupement complet)
    mais des valeurs différentes dans la colonne F alors regrouper mais placer la somme selon couleur 1>en 5 ; couleur2>en 6 ; couleur3>en 7 ...etc.
    puis passer a la ligne suivante.

    Le but principal étant de différencier les différents produits mélanger via le regroupement actuel ,
    dans la réalité pour les mêmes données c'est a dire largeur longueur hauteur, nous auront un produit différent au niveau de la forme,
    a ce niveau la il est nécessaire de les dissocier manuellement car les données n'informent pas un croquis et donc la forme .

    Cependant la couleur du produit est indiquée par un nom/numéro,
    au moment du regroupement de produits (via CAD) pour plusieurs couleurs de produits différent je définit par exemple couleur 1= 501
    couleur2= 502 et dans le croquis la somme indiquée dans un tableau se trouve en dessous des chiffres 1,2,
    j'aurai besoin de la forme de regroupement expliquée pour pouvoir comme dans le cadre d'une seule couleur présente pouvoir copier les données regroupées sans les modifier manuellement.

    en espérant avoir été un petit peut plus clair..

    je vous joint ce que représente le fichier final pour 4 couleur, cela vous éclairera peut être..
     

    Pièces jointes:

  19. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14632
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Bonjour.
    Code (Visual Basic):
       Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, Arg6 As SsGr, TTit(), RngCbl As Range, _
          TJoin() As String, J As Long, RngPoliceRg As Range, PfxArg As String, P As Long
       TTit = ActiveSheet.[A1:E1].Value
       ReDim TR(1 To 100000, 1 To 3)
       Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
       RngCbl.Font.Color = 0
       For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -3, -4, 1, 6)
          For Each Arg3 In Arg2.Co
             For Each Arg4 In Arg3.Co
                ReDim TJoin(1 To Arg3.Count): J = 0
                PfxArg = "?"
                For Each Arg1 In Arg4.Co: P = InStr(Arg1.Id, "-"): J = J + 1
                   If Left$(Arg1.Id, P) <> PfxArg Then
                      TJoin(J) = Arg1.Id: PfxArg = Left$(Arg1.Id, P)
                   Else: TJoin(J) = Mid$(Arg1.Id, P + 1): End If
                   For Each Arg6 In Arg1.Co
    '                Le problème c'est que je ne comprends pas du tout ce que vous voudriez faire à cet endroit.
    '                Au fait la concaténation des Arg1 est-elle bien toujours d'actualité ?
    '                Si le regroupement sur Agr6 est indépendant de celui sur Arg1 ça va devenir très compliqué, presque impossible !
                      Next Arg6, Arg1
                LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
                LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5): If Arg4.Somme(5) <= 5 Then TR(LR, 3) = 1
                Next Arg4, Arg3
          LR = LR + 5: Next Arg2
       RngCbl.Value = TR
       On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
       If Err = 0 Then
          RngCbl.Offset(, -1).Font.Color = &HFF&
          RngCbl.ClearContents: End If
    En fait il semblerait que le Arg1 ne se justifie plus dans vos dernières données: il n'y en a chaque fois qu'un seul dans chaque Arg4. Mais on peut le garder, juste pour avoir son Id, mais on aurait intérêt, si jamais il venait à y en avoir à nouveau plusieurs, à refaire un paquet entier des 5 lignes pour chaque.
    On pourrait peut être faire la boucle For Each Arg6 In Arg1.Co après les LR = LR + 1: TR(LR, 1) = etc.
    et donc en refaire un pour chaque couleur.
    Essayez ça: ça ne paraît pas inintéressant :
    Code (Visual Basic):
       Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, Arg6 As SsGr, TTit(), RngCbl As Range, _
          TJoin() As String, J As Long, RngPoliceRg As Range, PfxArg As String, P As Long
       TTit = ActiveSheet.[A1:F1].Value
       ReDim TR(1 To 100000, 1 To 3)
       Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
       RngCbl.Font.Color = 0
       For Each Arg2 In Gigogne(ActiveSheet.[A2:F2], -2, -3, -4, 1, 6)
          For Each Arg3 In Arg2.Co
             For Each Arg4 In Arg3.Co
                For Each Arg1 In Arg4.Co
                LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = Arg1.Id
                LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
                LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg1.Somme(5): If TR(LR, 2) <= 5 Then TR(LR, 3) = 1
                For Each Arg6 In Arg1.Co
                   LR = LR + 1: TR(LR, 1) = TTit(1, 6): TR(LR, 2) = Arg6.Id
                   LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg6.Somme(5): If TR(LR, 2) <= 5 Then TR(LR, 3) = 1
                   Next Arg6, Arg1, Arg4, Arg3
          LR = LR + 5: Next Arg2
       RngCbl.Value = TR
       On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
       If Err = 0 Then
          RngCbl.Offset(, -1).Font.Color = &HFF&
          RngCbl.ClearContents: End If

    Je vous suggère d'utiliser ce classeur pour faire des essais de la fonction Gigogne sur vos données
     

    Pièces jointes:

    Dernière édition: 14 Septembre 2018
  20. anri0610

    anri0610 XLDnaute Junior

    Inscrit depuis le :
    6 Août 2018
    Messages :
    50
    "J'aime" reçus :
    0
    Sexe :
    Masculin
    Habite à:
    Hokkaido
    Utilise:
    Excel 2013 (PC)
    Bonjour j'aurais vraiment essayer tout ce que j'ai pu mais je n’arrête pas de m'embrouiller..

    je pense qu'il n'est pas nécessaire que je note ce que j'ai essayer , j'ai essayer de modifier tous les ordres des arg sans atteindre le résultat souhaiter , je perdais soit le calcul de la somme soit j'avais en arg6.id une valeur différente...

    aidez moi s'il vous plait,

    je souhaiterai garder le résultat actuel , seulement ajouter la valeur de la colonne F,
    (cet arg6), dans le même cadre de fonctionnement que les autres arg,
    de manière a ce que comme jusqu’à maintenant la somme s'effectue si et quand toutes les valeur sont identiques.
    de manière a séparer et ne pas mélanger les données de cette colonne F,
    et seulement afficher a droite de la somme(5) la valeur correspondante a arg6.id pour information.

    je ne souhaite pas modifier l’écriture actuelle de la colonne I.
    aidez moi s'il vous plait je suis complètement perdu..
     

    Pièces jointes:

Chargement...
Discussions similaires - Regroupement données selon Forum Date
XL 2010 PROGRAMME DE REGROUPEMENT DE DONNÉES Forum Excel 14 Octobre 2018
Regroupement de données de 2 tableaux Forum Excel 9 Janvier 2018
XL 2010 VBA regroupement de données par colonne Forum Excel 20 Juillet 2017
XL 2010 Regroupement de données dans un TCD Forum Excel 24 Août 2016
Help : macro de copie de données et de regroupement d'informations Forum Excel 22 Avril 2016

Partager cette page