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 ?
Beaucoup plus sur 2013. Mais j'ai 2007 égalementvous 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
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,
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+
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é
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
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
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
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.
Re,
Ma proposition ne répond pas à la question ?
Cdlt.
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!!!