Classification selon critère

Bonjour à tous

je voudrais votre assistance par rapport à un travail

je voudrais classer en trois catégories des éléments comptés par deux équipes et faire une comparaison par rapport aux résultats obtenus

1- Éléments de même référence avec localisation différente

2- Eléments de même référence et de même localisation

3- Eléments avec différentes référence

Je joins un fichier montrant les résultats attendus

Je vous remercie par avance pour le coup de main

Fichiers joints

vous travaillez toujours sur Excel 2007 ?

Rrradassse a écrit :

vous travaillez toujours sur Excel 2007 ?

Du coup aucun problème a utiliser les Tableaux croisés dynamiques (TCD) (ils existent déjà sur Excel 2007 mais ils sont beaucoup moins intuitifs à utiliser)

Je ne suis pas sure d'avoir compris les différences entre les 3 tris mais je vous propose quand meme un exemple différent de ce qu'on peut faire avec l'outil TCD et juste placer les champs a des endroits différentes; 1 sur chaque onglet (cliquer sur le TCD pour voir l'outil qui permet de le modifier).

J'ai mis des "sommes" de quantités par défaut mais vous pouvez aussi ajouter le "max" des quantités, ou le % ...

J'ai mis des slicers car c'est plus "graphique" pour trier, mais je ne suis pas sure qu'ils existaient déjà sur Excel 2007. Dans ce cas il sufit de cliquer sur le tableau sur le champs qu'on veut trier puis sur la fleche en haut a gauche du tableau, et sélectionner ce qu'on garde

Salut Relmo,

Salut Rrradassse,

, ça bosse , la nuit, dirait-on...

Version VBA, avec un double-clic en feuille 'Base' [A1] pour démarrer la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iRow1%, iRow2%, iIdx%
'
If Not Intersect(Target, [A1]) Is Nothing Then
    iRow1 = 2
    Cancel = True
    Application.ScreenUpdating = False
    '
    Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
        key1:=Range("A2"), order1:=xlAscending, _
        key2:=Range("D2"), order2:=xlDescending, _
        Orientation:=xlTopToBottom, Header:=xlYes
    For x = 1 To 3
        With Worksheets(Choose(x, "R1", "R2", "R3"))
            .Cells.Delete
            Range("A1").Resize(1, 4).Copy Destination:=.[A1].Resize(1, 4)
            .Range("C1").Resize(1, 2).Value = Array("AM", "AB")
            .Range("A:D").HorizontalAlignment = xlHAlignCenter
        End With
    Next
    Do
        iRow2 = Range("A:A").Find(what:=Range("A" & iRow1).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
        iIdx = IIf(iRow1 < iRow2, IIf(Range("B" & iRow1).Value <> Range("B" & iRow2).Value, 1, 2), 3)
        With Worksheets(Choose(iIdx, "R1", "R2", "R3"))
            iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & iRow).Resize(IIf(iIdx = 1, 2, 1), 2).Value = Range("A" & iRow1).Resize(IIf(iIdx = 1, 2, 1), 2).Value
            If iIdx < 3 Then
                .Range("C" & iRow).Value = Range("C" & iRow1).Value
                .Range("D" & iRow + IIf(iIdx = 1, 1, 0)).Value = Range("C" & iRow2).Value
            End If
            If iIdx = 3 Then .Range(IIf(Range("D" & iRow1).Value = "AM", "C", "D") & iRow).Value = Range("C" & iRow1).Value
            .Range("A1:D" & iRow + IIf(iIdx = 1, 1, 0)).Borders.LineStyle = xlContinuous
            If iIdx = 1 Then .Range("A1:D" & .Range("A" & Rows.Count).End(xlUp).Row).Sort _
                key1:=.Range("A2"), order1:=xlAscending, _
                key2:=.Range("B2"), order2:=xlAscending, _
                key3:=.Range("D2"), order3:=xlDescending, _
                Orientation:=xlTopToBottom, Header:=xlYes
        End With
        iRow1 = iRow2 + 1
    Loop Until iRow2 = Range("A" & Rows.Count).End(xlUp).Row
End If
'
Application.ScreenUpdating = True
'
End Sub

A+

Rrradassse a écrit :

je vous propose quand meme un exemple différent de ce qu'on peut faire avec l'outil TCD et juste placer les champs a des endroits différentes; 1 sur chaque onglet (cliquer sur le TCD pour voir l'outil qui permet de le modifier).

J'ai mis des "sommes" de quantités par défaut mais vous pouvez aussi ajouter le "max" des quantités, ou le % ...

Bonjour Rrradassse,

Merci pour la solution TCD je l'avais essayé également (avec un peu degymnastiques pour réussir le tri) mais au niveau des référence se ressemblant mais avec des localisation différentes je bloquais parce qu'il fallait que je les présente uniquement dans un tableau isolé

Rrradassse a écrit :

J'ai mis des slicers car c'est plus "graphique" pour trier, mais je ne suis pas sure qu'ils existaient déjà sur Excel 2007.

PAr contre si vous avez un petit tuto qui me fera apprendre les slicer je suis preneur j'avoue que je ne connaissais pas.. Moi qui pensait avoir fait le tour en matière de TCD.

Merci

curulis57 a écrit :

ça bosse , la nuit, dirait-on.

Bonjour Curulis

quand il y a du boulot hahaha pas le choix!

Merci pour ta solution , elle est géniale et sur le modèle elle fait le job.... Bon avec 10 mille ligne ca tourne un peu mais c'est gérable

Fantastique

Bonjour à toutes et tous,

Une autre proposition VBA pour consolider les tables et les trier (?).

Les données sont sous forme de tableaux structurés.

Cdlt.

Public Sub Consolidate_data()
Dim ws As Worksheet
Dim r As Range, rng As Range
Dim tbl As Variant, arr() As Variant
Dim I As Long, J As Long, k As Long

    With Range("T_Base").ListObject
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set r = .InsertRowRange.Cells(1)
    End With

    For Each ws In ActiveWorkbook.Worksheets
        If ws.ListObjects.Count > 0 And ws.Name <> Range("T_Base").ListObject.Parent.Name Then
            If ws.ListObjects(1).InsertRowRange Is Nothing Then
                tbl = ws.ListObjects(1).Range.Value
                For I = 2 To UBound(tbl)
                    For J = 3 To UBound(tbl, 2)
                        If tbl(I, J) <> "" Then
                            ReDim Preserve arr(4, k + 1)
                            arr(0, k) = tbl(I, 1)
                            arr(1, k) = tbl(I, 2)
                            arr(2, k) = tbl(I, J)
                            arr(3, k) = tbl(1, J)
                            k = k + 1
                        End If
                    Next J
                Next I
            End If
        End If
    Next ws

    If k > 0 Then
        r.Resize(k, 4).Value = Application.Transpose(arr)
        Set rng = Range("T_Base")
        With rng.ListObject.Sort
            .SortFields.Add Key:=rng(0, 2)
            .SortFields.Add Key:=rng(0, 1)
            .SortFields.Add Key:=rng(0, 3), Order:=xlDescending
            .Header = xlYes
            .Apply
            .SortFields.Clear
        End With
    End If

End Sub

Jean-Eric a écrit :

Une autre proposition VBA pour consolider les tables et les trier (?).

Bonjour Jean Eric

La résolution se fait à l'envers apparemment. Normalement on doit partir de la feuille base pour aller vers les feuilles R1, R2 et R3

curulis57 a écrit :

Version VBA, avec un double-clic en feuille 'Base' [A1] pour démarrer la macro.

Désolé de revenir vers vous, j'ai une préoccupation

est-ce qu'il est possible de faire des cumuls pour un article ayant la même référence et le même emplacement?

Je me rends compte que la solution actuelle ne prend en compte que le premier élément trouvé

Merci

Ps: J'y ai mis le fichier avec le résultat attendu

curulis57 a écrit :

Version VBA, avec un double-clic en feuille

Bonjour Curuliss

Pensez-vous que la requête est possible (Que la macro cumule les quantités dont lés références et les localisations sont identiques dans chaque groupe (AB ou AM)

Ici la macro ne prend que le premier résultat trouvé

Salut Relmo,

oui, tout à fait. En VBA, tout, ou presque, est possible en se tordant assez les méninges.

J'ai commencé mais cool, hein!

A+

Bonjour,

Une proposition à étudier.

Pour Excel 2010+.

Données mises sous forme de tableau structuré, tableau croisé dynamique (TCD) et segment.

Cdlt.

curulis57 a écrit :

oui, tout à fait. En VBA, tout, ou presque, est possible

Merci merci.. je reste cool donc

Jean-Eric a écrit :

Données mises sous forme de tableau structuré, tableaucroisé dynamique (TCD) et segment.

Cdlt.

Comment on fait le TCD structuré avec segment? je veux bien apprendre pour l'appliquer à ma base

Re,

Ma proposition ne répond pas à la question ?

Cdlt.

Jean-Eric a écrit :

Re,

Ma proposition ne répond pas à la question ?

Cdlt.

Si tout de suite sur le modèle ça répond bien ... Mais je voudrais l’appliquer à mon travail source .. c’est pourquoi je voulais savoir comment on fait les segments

Re,

Il y a de nombreux tutos sur le internet, pour appréhender les segments (slicers en anglais) dans un tableau (structuré) Excel 2013+ ou dans un tableau croisé dynamique Excel 2010+.

Un lien parmi d'autres :

https://www.excel-exercice.com/les-segments-slicers/

Cdlt.

Salut Relmo,

Salut l'équipe,

le code adapté à la nouvelle donne.

Merci d'être resté cool!

Toujours un double-clic en [A1] pour démarrer la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iRowA%, iRow1%, iRow2%, iIdx%
'
If Not Intersect(Target, [A1]) Is Nothing Then
    iRow1 = 2
    Cancel = True
    On Error Resume Next
    Application.ScreenUpdating = False
    '
    Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
        key1:=Range("A2"), order1:=xlAscending, _
        key2:=Range("D2"), order2:=xlDescending, _
        Orientation:=xlTopToBottom, Header:=xlYes
    For x = 1 To 3
        With Worksheets(Choose(x, "R1", "R2", "R3"))
            .Cells.Delete
            Range("A1").Resize(1, 4).Copy Destination:=.[A1].Resize(1, 4)
            .Range("C1").Resize(1, 2).Value = Array("AM", "AB")
            .Range("A:D").HorizontalAlignment = xlHAlignCenter
        End With
    Next
    Do
        iRow2 = Range("A:A").Find(what:=Range("A" & iRow1).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
        If iRow1 = iRow2 Then iIdx = 3
        If iRow1 < iRow2 Then
            iIdx = 2
            For x = iRow1 + 1 To iRow2
                If Range("B" & iRow1).Value <> Range("B" & x).Value Then iIdx = 1
            Next
        End If
        With Worksheets(Choose(iIdx, "R1", "R2", "R3"))
            iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            For x = iRow1 To iRow2
                If x = iRow1 Then .Range("A" & iRow).Resize(1, 2).Value = Range("A" & iRow1).Resize(1, 2).Value
                If x = iRow1 Or iIdx > 1 Then .Range(IIf(Range("D" & x).Value = "AM", "C", "D") & iRow).Value = .Range(IIf(Range("D" & x).Value = "AM", "C", "D") & iRow).Value + Range("C" & x).Value
                If x > iRow1 And iIdx = 1 Then
                    Set rCel = .Range("B" & iRow & ":B" & .Range("B" & Rows.Count).End(xlUp).Row).Find(what:=Range("B" & x).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
                    iRowA = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    If Not rCel Is Nothing Then iRowA = rCel.Row
                    If rCel Is Nothing Then .Range("A" & iRowA).Resize(1, 2).Value = Range("A" & x).Resize(1, 2).Value
                    .Range(IIf(Range("D" & x).Value = "AM", "C", "D") & iRowA).Value = .Range(IIf(Range("D" & x).Value = "AM", "C", "D") & iRowA).Value + Range("C" & x).Value
                End If
            Next
        End With
        iRow1 = iRow2 + 1
    Loop Until iRow2 = Range("A" & Rows.Count).End(xlUp).Row
    For x = 1 To 3
        With Worksheets(Choose(x, "R1", "R2", "R3"))
            .Range("A1:D" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
            If x = 1 Then .Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
                key1:=.Range("A2"), order1:=xlAscending, _
                key2:=.Range("B2"), order2:=xlAscending, _
                key3:=.Range("D2"), order3:=xlDescending, _
                Orientation:=xlTopToBottom, Header:=xlYes
        End With
    Next
End If
'
Application.ScreenUpdating = True
On Error GoTo 0
'
End Sub

A+

le code adapté à la nouvelle donne.

Bonjour Curilis!

Je suis émerveillé!!! C'est génial!! Quel travail vous avez fait!! Cest super sympa!

J'ai bien fait de patienter

Merci beaucoup!!!