XL 2016 Nombre de personnes représentant les 80% du résultat total en fonction de critères

ntb · 24 Juin 2021

Bonjour à toutes et à tous,

Je comporte actuellement un tableau regroupant différentes équipes. Ces dernières sont soit de couleur noire soit de couleur rouge. Chacune d'entre elle comporte un nom d'équipe propre ainsi qu'un résultat. J'aimerai déterminer le nombre d'équipes noires représentant les 80% du résultat total des équipes noires. J'ai essayé une macro mais elle ne fonctionne pas, si l'un de vous à une idée je suis preneuse.

N'hésitez pas si vous avez des questions.

Merci

job75 · 24 Juin 2021

Bonjour ntb,

Il faut préciser que pour le calcul des 80% les valeurs doivent être triées par ordre décroissant.

Voyez le fichier joint et cette fonction VBA :

VB:

Function NbEquipe&(couleur$, ColonneCoul As Range, ColonneVal As Range, pct#)
Dim i&, v, n&, a#(), borne#, s#
Set ColonneCoul = Intersect(ColonneCoul, ColonneCoul.Parent.UsedRange)
Set ColonneVal = Intersect(ColonneVal, ColonneVal.Parent.UsedRange)
For i = 1 To ColonneCoul.Count
    If ColonneCoul(i) = couleur Then
        v = ColonneVal(i)
        If IsNumeric(v) Then
            ReDim Preserve a(n)
            a(n) = v
            n = n + 1
        End If
    End If
Next
tri a, 0, UBound(a)
borne = pct * Application.Sum(a)
For i = 0 To UBound(a)
    s = s + a(i)...

mapomme · 24 Juin 2021

Bonjour @ntb ,

Question imprécise :

Comment prendre en compte les équipes de la couleur désirée? :

du plus petit résultat au plus grand
du plus grand résultat au plus petit
dans l'ordre d'affichage du tableau
au hasard

Et dans chaque cas, on risque de trouver un nombre d'équipe différent!

De plus, vu la répartition des équipes, aucune équipe (rouge ou noir) n'atteindra jamais les 80% du total de la ligne 28.

Bref précisez ce que vous voulez...

Dranreb · 24 Juin 2021

Bonjour.
Dans votre exemple aucune des deux couleur d'équipe n'atteint 80% du total

Nombre d'équipes de couleur rouge représentant 57 % de 711675	Nombre d'équipes de couleur noir représentant 43 % de 711675
14	10

Mais j'ai vu que la demande était différente de ce que j'ai trouvé dans le classeur, alors c'est plutôt ça :

Nombre d'équipes de couleur rouge représentant 85 % de 407579	Nombre d'équipes de couleur noir représentant 86 % de 304096
7	6

ntb · 24 Juin 2021

mapomme à dit:
Bonjour @ntb ,

Question imprécise :

Comment prendre en compte les équipes de la couleur désirée? :

du plus petit résultat au plus grand

du plus grand résultat au plus petit

dans l'ordre d'affichage du tableau

au hasard

Et dans chaque cas, on risque de trouver un nombre d'équipe différent!

De plus, vu la répartition des équipes, aucune équipe (rouge ou noir) n'atteindra jamais les 80% du total de la ligne 28.

Bref précisez ce que vous voulez...

Non désolé j'ai oublié de préciser que je voulais le nombre d'équipe rouge représentant les 80% du résultat total des équipes rouges et non pas de l'ensemble des équipes.

Dans l'excel je rajouterai donc une somme =SOMME.SI(A4:A27;"rouge";C4:C27) et ensuite je voudrais calculer le nombre d'équipe rouge qui représente les 80% de cette somme. Peut-être est-ce plus clair?

job75 · 24 Juin 2021

Bonjour ntb,

Il faut préciser que pour le calcul des 80% les valeurs doivent être triées par ordre décroissant.

Voyez le fichier joint et cette fonction VBA :

VB:

Function NbEquipe&(couleur$, ColonneCoul As Range, ColonneVal As Range, pct#)
Dim i&, v, n&, a#(), borne#, s#
Set ColonneCoul = Intersect(ColonneCoul, ColonneCoul.Parent.UsedRange)
Set ColonneVal = Intersect(ColonneVal, ColonneVal.Parent.UsedRange)
For i = 1 To ColonneCoul.Count
    If ColonneCoul(i) = couleur Then
        v = ColonneVal(i)
        If IsNumeric(v) Then
            ReDim Preserve a(n)
            a(n) = v
            n = n + 1
        End If
    End If
Next
tri a, 0, UBound(a)
borne = pct * Application.Sum(a)
For i = 0 To UBound(a)
    s = s + a(i)
    If s >= borne Then Exit For
Next
NbEquipe = i + 1
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = Val(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
    Do While Val(a(g)) > ref: g = g + 1: Loop
    Do While ref > Val(a(d)): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Nota : en colonne A j'ai supprimé les espaces après rouge et noir...

On vérifiera facilement en triant le tableau que :

- les 7 premières valeurs rouges représentent 84,9% du total rouge

- les 6 premières couleurs noires représentent 85,8% du total noir.

Edit : salut mapomme, Bernard, comme d'habitude la page XLD n'était pas à jour.

A+

Dranreb · 24 Juin 2021

Le mien.

mapomme · 24 Juin 2021

Re,

Avec une fonction personnalisée : Function NbrEquipe(plage As Range, couleur As String, ratio As Long, methode As String)

plage : la plage du tableau sans les en-têtes ni le total
couleur : la couleur à retenir
ratio : le nombre entier à atteindre
methode : la méthode à utiliser

methode = "+" on prend les équipes à plus fort résultat jusqu'aux équipes à plus faible résultat
methode = "-" on prend les équipes à plus faible résultat jusqu'aux équipes à plus fort résultat
methode = "=" on prend les équipes dans l'ordre du tableau

Voir les formules de G4 à H6.

VB:

Function NbrEquipe(plage As Range, couleur As String, ratio As Long, methode As String)
Dim t, ech As Boolean, j&, i&, aux, total, somme, nbr&
   t = plage
   If methode = "+" Then
      Do
         ech = False
         For i = 1 To UBound(t) - 1
            If t(i, 3) < t(i + 1, 3) Then
               For j = 1 To 3: aux = t(i, j): t(i, j) = t(i + 1, j): t(i + 1, j) = aux: ech = True: Next j
            End If
         Next i
      Loop Until ech = False
   ElseIf methode = "-" Then
      Do
         ech = False
         For i = 1 To UBound(t) - 1
            If t(i, 3) > t(i + 1, 3) Then
               For j = 1 To 3: aux = t(i, j): t(i, j) = t(i + 1, j): t(i + 1, j) = aux: ech = True: Next j
            End If
         Next i
      Loop Until ech = False
   End If
   For i = 1 To UBound(t): total = total + IIf(Trim(t(i, 1)) = Trim(couleur), t(i, 3), 0): Next
   For i = 1 To UBound(t)
      If Trim(t(i, 1)) = Trim(couleur) Then
         somme = somme + t(i, 3)
         nbr = nbr + 1
         If (somme / total) >= ratio / 100 Then NbrEquipe = nbr: Exit Function
      End If
   Next i
End Function

ntb · 24 Juin 2021

Super merci à tous pour votre aide, vous m'avez aidé à trouver la bonne solution

Bonne fin de journée

XL 2016 Nombre de personnes représentant les 80% du résultat total en fonction de critères

ntb

XLDnaute Nouveau

Pièces jointes

job75

mapomme

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

ntb

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

ntb

XLDnaute Nouveau

Discussions similaires