Formule Max à optimiser ou somme Max
Bonsoir le forum,
Dans un classeur, j'ai une base de données en feuil1, que j'alimente une fois par semaine. Des références apparaissent donc plusieurs fois dans cette même feuille.
J'ai demandé au forum une formule max pour faire un Pareto, et le problème est que la formule Max ne m'afficher le Max d'une ref alors que dit dit plus haut elle apparaît plusieurs fois.
C'est pourquoi je souhaiterai une fonction somme Max si possible?
En vous remerciant d'avance.
Cordialement,
Max
Max6546 a écrit :Bonsoir le forum,
Dans un classeur, j'ai une base de données en feuil1, que j'alimente une fois par semaine. Des références apparaissent donc plusieurs fois dans cette même feuille.
J'ai demandé au forum une formule max pour faire un Pareto, et le problème est que la formule Max ne m'afficher le Max d'une ref alors que dit dit plus haut elle apparaît plusieurs fois.
C'est pourquoi je souhaiterai une fonction somme Max si possible?
En vous remerciant d'avance.
Cordialement,
Max
Avec le fichier ça sera beaucoup mieux
Bonsoir à tous,
Si j'ai bien compris.
Restitution en Feuil2.
Option Explicit
Sub Pic_Article()
Dim a, i As Long, j As Long, txt As String, n As Long
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("A1").CurrentRegion
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(3, 6, 10))
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(a, 1)
txt = a(i, 1)
If Not .exists(txt) Then
n = n + 1
.Item(txt) = n
For j = 1 To UBound(a, 2)
a(n, j) = a(i, j)
Next
Else
If a(.Item(txt), 3) <= a(i, 3) Then
For j = 1 To UBound(a, 2)
a(.Item(txt), j) = a(i, j)
Next
End If
End If
Next
End With
With Sheets("Feuil2").Range("A1")
.CurrentRegion.Clear
.Cells(1).Resize(n, UBound(a, 2)).Value = a
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.Font.Size = 11
.Interior.ColorIndex = 38
.BorderAround Weight:=xlThin
End With
.Columns.AutoFit
.Sort key1:=.Cells(3), order1:=2, Header:=1
End With
End With
Application.ScreenUpdating = True
End Sub
klin89
Jean-Eric a écrit :Bonjour,
Pour le fun et Excel 2010 et +.
Cdlt.
Super l'idée du TCD, dommage qu'on aie pas 2010 au travail
Re,
Alors, sans les segments propres à Excel 2010 et +
A adapter.
Cdlt.
Klin89 a écrit :Bonsoir à tous,
Si j'ai bien compris.
Restitution en Feuil2.
Option Explicit Sub Pic_Article() Dim a, i As Long, j As Long, txt As String, n As Long Application.ScreenUpdating = False With Sheets("Feuil1").Range("A1").CurrentRegion a = Application.Index(.Value, Evaluate("row(1:" & _ .Rows.Count & ")"), Array(3, 6, 10)) End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To UBound(a, 1) txt = a(i, 1) If Not .exists(txt) Then n = n + 1 .Item(txt) = n For j = 1 To UBound(a, 2) a(n, j) = a(i, j) Next Else If a(.Item(txt), 3) <= a(i, 3) Then For j = 1 To UBound(a, 2) a(.Item(txt), j) = a(i, j) Next End If End If Next End With With Sheets("Feuil2").Range("A1") .CurrentRegion.Clear .Cells(1).Resize(n, UBound(a, 2)).Value = a With .CurrentRegion .Font.Name = "calibri" .Font.Size = 10 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Borders(xlInsideVertical).Weight = xlThin .BorderAround Weight:=xlThin With .Rows(1) .Font.Size = 11 .Interior.ColorIndex = 38 .BorderAround Weight:=xlThin End With .Columns.AutoFit .Sort key1:=.Cells(3), order1:=2, Header:=1 End With End With Application.ScreenUpdating = True End Sub
klin89
Bonsoir Klin,
Merci pour ta macro, mais le résultat n'est pas celui attendu. Il ne prend en compte le match que d'une ref, alors que la même ref peut plusieurs fois (chaque semaine).
Cordialement,
Max
Jean-Eric a écrit :Re,
Alors, sans les segments propres à Excel 2010 et +
A adapter.
Cdlt.
Merci Jean-Eric,
J'ai beau me casser la tête avec des formules, je pense que les TCD restent une des meilleures solutions.
J'ai toujours eu du mal par contre pour les filtres (décroissant ou croissant) sur les TCD, et je pense que je viens de comprendre pourquoi: je mettrai trop de champs dans les lignes du rapport.
Pourquoi avoir fait une rechercheV concernant la désignation article? est-ce dû mon problème expliqué ci-dessus?
Merci
Max
Re,
J'ai utilisé cet artifice pour la représentation graphique.
Essaie d'ajouter la désignation de l'article dans le TCD (étiquettes de lignes).
Cdt.
Amadéus a écrit :Bonjour
Ou une colonne intermédiaire
Cordialement
Amadeus,
je n'arrive pas à ouvrir le le fichier malgré Winzip téléchargé.
Cdlt
max
Bonjour
je n'arrive pas à ouvrir le le fichier malgré Winzip téléchargé.
Pour une fois, nous allons enfreindre la règle des 300Ko.
Cordialement
Amadéus a écrit :Bonjour
je n'arrive pas à ouvrir le le fichier malgré Winzip téléchargé.
Pour une fois, nous allons enfreindre la règle des 300Ko.
Cordialement
Parfait,
Merci Amadeus
Cordialement,
Max
Re Max6546,
J'ai pigé
Restitution en Feuil2.
Option Explicit
Sub Pic_Article()
Dim a, i As Long, j As Long, txt As String, n As Long
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("A1").CurrentRegion
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(3, 6, 10))
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(a, 1)
txt = a(i, 1)
If Not .exists(txt) Then
n = n + 1
.Item(txt) = n
For j = 1 To UBound(a, 2)
a(n, j) = a(i, j)
Next
Else
If txt <> "Article" Then
a(.Item(txt), 3) = a(.Item(txt), 3) + a(i, 3)
End If
End If
Next
End With
With Sheets("Feuil2").Range("A1")
.CurrentRegion.Clear
.Cells(1).Resize(n, UBound(a, 2)).Value = a
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Rows(1)
.Font.Size = 11
.Interior.ColorIndex = 38
.BorderAround Weight:=xlThin
End With
.Columns.AutoFit
.Sort key1:=.Cells(3), order1:=2, Header:=1
End With
End With
Application.ScreenUpdating = True
End Sub
klin89
Klin89 a écrit :Re Max6546,
J'ai pigé
Restitution en Feuil2.
Option Explicit Sub Pic_Article() Dim a, i As Long, j As Long, txt As String, n As Long Application.ScreenUpdating = False With Sheets("Feuil1").Range("A1").CurrentRegion a = Application.Index(.Value, Evaluate("row(1:" & _ .Rows.Count & ")"), Array(3, 6, 10)) End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To UBound(a, 1) txt = a(i, 1) If Not .exists(txt) Then n = n + 1 .Item(txt) = n For j = 1 To UBound(a, 2) a(n, j) = a(i, j) Next Else If txt <> "Article" Then a(.Item(txt), 3) = a(.Item(txt), 3) + a(i, 3) End If End If Next End With With Sheets("Feuil2").Range("A1") .CurrentRegion.Clear .Cells(1).Resize(n, UBound(a, 2)).Value = a With .CurrentRegion .Font.Name = "calibri" .Font.Size = 10 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Borders(xlInsideVertical).Weight = xlThin .BorderAround Weight:=xlThin With .Rows(1) .Font.Size = 11 .Interior.ColorIndex = 38 .BorderAround Weight:=xlThin End With .Columns.AutoFit .Sort key1:=.Cells(3), order1:=2, Header:=1 End With End With Application.ScreenUpdating = True End Sub
klin89
Merci Klin89,