Extraction de valeurs maximum

A

apt

XLDnaute Impliqué
Bonjour à tous,

J'aimerais, en VBA, extraire la valeur Max de la colonne F (QS) et G (QT).

Ensuite récupérer les valeurs de NCS, dans la colonne B, correspondantes à la plus grande valeur (QS) et (Qt).

Enfin trouver la plus grande valeur dans la colonne B selon les valeurs collectées en deuxième phase.

Merci d'avance.

:)
 

Pièces jointes

  • MaxValeurs (1).xls
    70.5 KB · Affichages: 110
Trier par date Trier par votes
eriiic

eriiic

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Bonjour tout le monde,

@apt : tu peux oublier les questions que je t'ai posées ici.
Comme tu as l'air d'avoir du mal à y répondre, que tu n'as pas la politesse de signaler avoir posté sur plusieurs forums et que je n'aime pas travailler pour rien je laisse tomber.
eric
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Bonjour,
à tester sur ton dernier fichier fourni (résultats en AA2) :
Code: 
Sub GrandesValeurs()
Set Pl = Range("A4:G" & Range("A" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.Dictionary")
T = Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
    For Each c In T
        dico(c) = dico(c)
    Next c
temp = dico.keys
ReDim T2(dico.Count, 3)
For i = LBound(temp) To UBound(temp)
T2(i, 0) = temp(i)
For j = 1 To Pl.Rows.Count
    If Pl(j, 1) = temp(i) And Pl(j, 7) > QT Then QT = Pl(j, 7): NCS1 = Pl(j, 2)
    If Pl(j, 1) = temp(i) And Pl(j, 6) > QS Then QS = Pl(j, 6): NCS2 = Pl(j, 2)
Next j
T2(i, 1) = Application.WorksheetFunction.Max(NCS1, NCS2): NCS1 = 0: NCS2 = 0
T2(i, 2) = QS: QS = 0
T2(i, 3) = QT: QT = 0
Next i
[AA2].Resize(UBound(T2) + 1, UBound(T2, 2) + 1) = T2
End Sub
A+
Edit : je viens de voir le message de Eriiic : si c'est le cas, je ne trouve pas que cette façon de faire soit correcte.
 
Dernière édition:
Vote positif 0 Vote négatif
A

apt

XLDnaute Impliqué
Re : Extraction de valeurs maximum

Bonsoir eriiic, Rachid, david.

eriiic > C'est un petit oubli sans rien d'autres

Mais soit sur et certain, que s'il y'aura une solution ici ou autre, je la partagerai sans problème pour faire profiter les autres.

Rachid > J'ai essayé d'appliquer les formules en J2, mais je n'ai que des erreurs !

david > J'ai une erreur pour l'objet WGH312D dans sa valeur NCS=526 au lieu de 721 et QS=41,83% au lieu de 45;63%

Exemple pour les formules et code VBA en PJ.
 

Pièces jointes

  • Max3Values_3.xls
    53.5 KB · Affichages: 39
  • Max3Values_3.xls
    53.5 KB · Affichages: 61
  • Max3Values_3.xls
    53.5 KB · Affichages: 39
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Re
Je t'avais pourtant précisé :
à tester sur ton dernier fichier fourni
Cliquez pour agrandir...
Si tu changes ton fichier cela ne peut fonctionner.
Le code fonctionne. Simplement, la plage de ton fichier précédent débute en A4 alors que celle de ton fichier débute en A2.
Si tu avais pris la peine d'étudier un tant soit peu le code, tu t'en serais aperçu tout seul.
A toi d'aller dans l'éditeur VBA et de modifier l'instanciation de Pl et de T et tu verras que cela fonctionne.
A+
Edit : je viens de regarder le fichier de Rachid et pour moi ses résultats sont bons.
 
Dernière édition:
Vote positif 0 Vote négatif
R@chid

R@chid

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Bonsoir @ tous,
Bonsoir David,
@ Apt : on va pas se mettre a tout faire...
il faut suivre les conseils, j'ai dit de valider par Ctrl+Maj+Entree et tout ça va fonctionner,
et pour la premiere formule en colonne J c'est *4 pas *2 avec validation Classique.
Voir PJ
Je quitte cette discussion maintenant
Amicalement
 

Pièces jointes

  • Max3Values_3.xls
    47.5 KB · Affichages: 35
  • Max3Values_3.xls
    47.5 KB · Affichages: 34
  • Max3Values_3.xls
    47.5 KB · Affichages: 39
Vote positif 0 Vote négatif
A

apt

XLDnaute Impliqué
Re : Extraction de valeurs maximum

Re,

Effectivement, il falait changé les Pl et T.

En voulant tester le code sur d'autres exemples, ça n'a pas donné le résultat voulu :

Ces deux exemples :

JCW0D 0
JCW0D 0
JCW0D 1 1 1 1 100,00% 100,00%
JCW0D 2 2 2 2 100,00% 100,00%
GHB0D 6 6 6 2 33,33% 100,00%
GHB0D 13 13 13 12 92,31% 100,00%
GHB0D 19 19 19 12 63,16% 100,00%
GHB0D 10 10 10 7 70,00% 100,00%

Ca donne :

JCW0D 1 100,00% 100,00%
GHB0D 13 92,31% 100,00%

au lieu de donner :

JCW0D 2 100,00% 100,00%
GHB0D 19 92,31% 100,00%

Il faudra que NCS=2 et 19 au de NCS=1 et 13
 
Vote positif 0 Vote négatif
A

apt

XLDnaute Impliqué
Re : Extraction de valeurs maximum

Bonjour Rachid,

Tes formules règlent le problème des deux dernière exemples ajoutés (Objet=JCW0D et GHB0D).

Seulement, comme j'ai demandé au début, j'aimerais intégrer ces formules dans le code VBA.

Alors j'ai essayé de faire cela :

En L2 :

Code: 
    '=SI($J2<>"";MAX(SI(($A$2:$A$41=$J2)*($B$1:$G$1=L$1);$B$2:$G$41));"")
    .Range("L2").FormulaArray = "=IF($J2<>" & "" & ",MAX(IF(($A$2:$A$41=$J2)*($B$1:$G$1=L$1),$B$2:$G$41))," & "" & ")"

En M2 :

Code: 
    '=SI($J2<>"";MAX(SI(($A$2:$A$41=$J2)*($B$1:$G$1=L$1);$B$2:$G$41));"")
    .Range("M2").FormulaArray = "=IF($J2<>" & "" & ",MAX(IF(($A$2:$A$41=$J2)*($B$1:$G$1=L$1),$B$2:$G$41))," & "" & ")"

En K2 :

Code: 
      '=SI(J2<>"";MAX(MAX(SI((A$2:A$41=J2)*(F$2:F$41=L2);B$2:B$41));MAX(SI((A$2:A$41=J2)*(G$2:G$41=M2);B$2:B$41)));"")
    .Range("K2").FormulaArray = "=IF((J2<>" & "" & ",MAX(MAX(IF((A$2:A$41=J2)*(F$2:F$41=L2),B$2:B$2)),MAX(IF((A$2:A$41=J2)*(G$2:G$41=M2),B$2:B$41)))," & "" & ")"

J'aimerais corriger la traduction des formules en code VBA.

Merci. :)
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Re, bonjour Rachid,
@apt : je ne comprends pas ton dernier exemple : pourquoi veux-tu obtenir
GHB0D 19 92,31% 100,00%
Cliquez pour agrandir...
alors que les QT sont égaux (100%) et que donc le NCS ramené doit correspondre à la ligne du QS le plus élevé (92,31%), donc 13 ?
Visiblement, soit je ne comprends pas ce que tu veux, soit tu ne sais pas l'expliquer (sans compter que tu rajoutes à chaque fois d'autres cas non présents initialement au lieu de les mettre dès le départ) : dans les 2 cas, autant passer mon chemin.
A+
 
Vote positif 0 Vote négatif
A

apt

XLDnaute Impliqué
Re : Extraction de valeurs maximum

Bonsoir david,

Non, c’est la même analyse pour toutes les données.

Comme on a 4 valeurs de QT = 100% (NCS={6, 13, 19, 10}), et QS =92,31% (NCS={13}), donc on choisira la plus grande valeur de NCS entre les 4 valeurs ramenés de la colonne B, à savoir (6, 13, 19, 10) donc MAX(NCS) = 19.

Pour les nouveaux cas, je les découvre pendant le teste sur la totalité des données.
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Re
A tester pour voir si j'ai bien compris cette fois :
Code: 
Sub GrandesValeurs()
Dim Pl As Range, PlObj As Range, PlQT As Range, PlQS As Range, dico As Object, i&, j&, T, T2(), c, temp
Dim firstAddress, NCS As Double, MaxQT As Double, MaxQS As Double
With Sheets("David")
    Set Pl = .Range("A1:G" & .Range("A" & Rows.Count).End(xlUp).Row)
    Set dico = CreateObject("Scripting.Dictionary")
    T = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
        For Each c In T
            dico(c) = dico(c)
        Next c
    temp = dico.keys
    ReDim T2(dico.Count, 3)
    For i = LBound(temp) To UBound(temp)
        T2(i, 0) = temp(i)
        
        Set c = Pl.Columns(1).Find(temp(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then firstAddress = c.Address
            MaxQT = Application.Evaluate("MAX(IF(" & Pl.Columns(1).Address(External:=True) & _
            "=" & c.Address & "," & Pl.Columns(7).Address(External:=True) & "))")
            MaxQS = Application.Evaluate("MAX(IF(" & Pl.Columns(1).Address(External:=True) & _
            "=" & c.Address & "," & Pl.Columns(6).Address(External:=True) & "))")
        
        For j = 1 To Pl.Rows.Count
            If Pl(j, 1) = temp(i) And (Pl(j, 7) = MaxQT Or Pl(j, 6) = MaxQS) And Pl(j, 2) > NCS Then NCS = Pl(j, 2)
        Next j
        
        T2(i, 1) = NCS: NCS = 0
        T2(i, 2) = MaxQS
        T2(i, 3) = MaxQT
    Next i
    .[J2].Resize(UBound(T2) + 1, UBound(T2, 2) + 1) = T2
End With
End Sub
A+
 

Pièces jointes

  • apt_MaxValues.xls
    63 KB · Affichages: 59
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Extraction de valeurs maximum

Re
Tu démarrages l'enregistreur de macros, tu rentres les formules en les validant en matriciel, tu arrêtes l'enregistreur de macros et tu ouvres VBE (alt F11) : tu y trouveras les formules.
A+
 
Vote positif 0 Vote négatif
A

apt

XLDnaute Impliqué
Re : Extraction de valeurs maximum

Bonsoir david,

Voila un essai concluant, sauf la mise en forme :

Code: 
Sub MaxVal()
    Dim LastLg As Integer
    Dim LastRw As Integer

    With Sheets("feuil1")
        '.Range("J1:M" & .[A65000].End(xlUp).Row).Clear
        .Range("J1:M" & .[A65000].End(xlUp).Row).Delete Shift:=xlUp
        
        LastLg = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LastLg).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
                                                                                  "J1"), Unique:=True
        .[K1] = .[B1]
        .[L1] = .[F1]
        .[M1] = .[G1]

        With .Range("J1:M1")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        ' Ca ne marche pas encore !!
        .Range("J1:M1").Interior.ColorIndex = .[A1].Interior.ColorIndex

        LastRw = .Range("J" & Rows.Count).End(xlUp).Row

        ' Ca ne marche pas encore!!
        With .Range("J1:M" & LastRw)
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
        End With

        MsgBox " LastLg = " & LastLg

        .Range("A2:A" & LastLg).Name = "Objet"
        .Range("B2:B" & LastLg).Name = "NCS"
        .Range("F2:F" & LastLg).Name = "QS"
        .Range("G2:G" & LastLg).Name = "QT"
    End With

    'SI(J2<>"";MAX(MAX(SI((A$2:A$33=J2)*(F$2:F$33=L2);B$2:B$33));MAX(SI((A$2:A$33=J2)*(G$2:G$33=M2);B$2:B$33)));"")
    Range("K2").FormulaArray = _
    "=IF(J2<>"""",MAX(MAX(IF((Objet=J2)*(QS=L2),NCS)),MAX(IF((Objet=J2)*(QT=M2),NCS))),"""")"
    Range("K2").AutoFill Destination:=Range("K2:K" & LastLg)

    'SI($J2<>"";MAX(SI(($A$2:$A$33=$J2)*($B$1:$G$1=L$1);$B$2:$G$33));"")
    Range("L2").FormulaArray = _
    "=IF($J2<>"""",MAX(IF((Objet=$J2)*($B$1:$G$1=L$1),$B$2:$G$" & LastLg & ")),"""")"
    Range("L2").AutoFill Destination:=Range("L2:L" & LastLg)

    '=SI($J2<>"";MAX(SI(($A$2:$A$33=$J2)*($B$1:$G$1=M$1);$B$2:$G$33));"")
    Range("M2").FormulaArray = _
    "=IF($J2<>"""",MAX(IF((Objet=$J2)*($B$1:$G$1=M$1),$B$2:$G$" & LastLg & ")),"""")"
    Range("M2").AutoFill Destination:=Range("M2:M" & LastLg)

    Range("L2:L" & LastLg).NumberFormat = "0.00%"
    Range("M2:M" & LastLg).NumberFormat = "0.00%"

End Sub

:)
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2021 Extraire valeurs après caractère spécial ou numérique
2
Réponses
20
Affichages
715
R@chid
R@chid
W
  • Question
Microsoft 365 Fusionne les cellules vides parmi celle avec des valeurs
Réponses
4
Affichages
231
woira95
W
G
  • Résolu(e)
XL 2016 IndeX EQUIV -
Réponses
6
Affichages
594
Gomar13
G
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Classement par zone (de 01 - 50) selon la cellule D5
Réponses
12
Affichages
446
chaelie2015
chaelie2015
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Affichage des en-têtes de tableau selon l'ordre
2
Réponses
20
Affichages
815
chaelie2015
chaelie2015
D
  • Question
Microsoft 365 Cas réel - avec problème complexe sur de la prevision de match en evitant les doublons
Réponses
1
Affichages
325
Dock91
D
M
  • Résolu(e)
XL 2016 VBA - Traitement de données en fonction de plusieurs critères avec Dictionary
2
Réponses
29
Affichages
1 K
Mak_tarmak
M
F
  • Question
XL 2019 Faire une "cartographie" selon des périodes.
Réponses
12
Affichages
664
fanou06
F
S
  • Résolu(e)
Microsoft 365 Recherche de date en VBA
Réponses
6
Affichages
251
sylvanu
sylvanu
C
  • Résolu(e)
Microsoft 365 SommeSi VBA avec integration de variable
Réponses
5
Affichages
317
danielco
D

Membres actuellement en ligne

13 membres et 146 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 371
Messages
2 087 697
Membres
103 644
dernier inscrit
bsalah