Extraction de valeurs maximum

[apt]

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.

 

[R@chid]

Re : Extraction de valeurs maximum

Bonjour Apt,
Je ne suis pas sur d'avoir compris,
mais peut être cette formule en K2 fera l'affaire,

=MAX(SI(($B$1:$G$1=K$1)*($A$2:$A$33=$J2);$B$2:$G$33))

Matricielle vers le bas et vers la droite
Amicalement

 

[apt]

Re : Extraction de valeurs maximum

Bonjour Rachid,

As-tu ouvert le fichier pour voir le résultat ?

Et comme tu es un as des formules, peut-être on pourra intégrer tes formules dans le code VBA après

 

[R@chid]

Re : Extraction de valeurs maximum

Re,
Oui je l'ai ouvert...
Mais j'ai pas bien compris comme j'ai dit...

 

[apt]

Re : Extraction de valeurs maximum

Bon,

Ce que j'aimerais avoir c'est :

- Pour chaque objet dans la colonne A, on devra extraire sa plus grande valeur dans la colonne F (QS avec couleur rose) et G (QT avec couleur bleu)

- Une fois QS retrouvée, on récupère dans la même ligne ou elle se trouve la valeur équivalente en colonne B (NCS)

- De même pour QT

- Parmi toutes les valeurs correspondantes dans la colonne B, on cherche à récupérer la plus grande valeur pour l'affecter à NCS (couleur marron).

- On a terminé le traitement pour le premier objet, on colle tous ça dans le tableau (Colonne J à M).

- On refait le même traitement pour le reste des objets existants dans la colonne A.

Ben voila, j'espère avoir bien expliqué ma problématique.

Merci.

 

[apt]

Re : Extraction de valeurs maximum

Bonjour,

Une réponse ?

 

[david84]

Re : Extraction de valeurs maximum

Bonjour,
à tester :

Sub GrandesValeurs()
Set Pl = Range("A2: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
Call tri(temp, LBound(temp), UBound(temp))
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, 2) > NCS Then NCS = Pl(j, 2)
    If Pl(j, 1) = temp(i) And Pl(j, 6) > QS Then QS = Pl(j, 6)
    If Pl(j, 1) = temp(i) And Pl(j, 7) > QT Then QT = Pl(j, 7)
Next j
T2(i, 1) = NCS: NCS = 0
T2(i, 2) = QS: QS = 0
T2(i, 3) = QT: QT = 0
Next i
[J2].Resize(UBound(T2) + 1, UBound(T2, 2) + 1) = T2
End Sub
Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: D = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < 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

A+

 

[apt]

Re : Extraction de valeurs maximum

Bonjour david,

Ca ne marche pas à tous les coups !

Parce qu'on doit chercher parmi les valeurs de NCS correspondantes aux valeurs max de QS et QT

Dans le cas ou ça n'a pas marché on prendra :

LCP52A 217 89,47% 100,00%
LCP52D 450 58,07% 93,79%

Le NCS de LCP52A sera 19 et non pas 217

Parce que la plus grande valeur entre le MAX(QS=86,47%, Ligne=16, NCS=19) et MAX(QT=100%, Ligne=16, NCS=19) est 19

Le NCS de LCP52D sera 322 et non pas 450

Parce que la plus grande valeur entre le MAX(QS=58,07%, Ligne=12, NCS=322) et MAX(QT=93,79%, Ligne=12, NCS=322) et 322

De même pour PHDM0A, on doit trouver 8 et non pas 10, parce qu'on a trois valeurs correspondantes au maximum de QS et QT (NCS=8, 2, 2)

 

[apt]

Re : Extraction de valeurs maximum

Salut,

Un essai avec encore des erreurs :

Sub GrandesValeurs()
    Dim D() As Variant, R() As Variant
    Dim d1 As Object
    Dim C As Range    '! Single, #DOuble
    Dim temp$, temp1!, temp2!, L1%, L2%, i As Byte, j As Byte
    Dim temp11!, temp22!, NS$
    Dim Tbl() As tabloStructure

    Set d1 = CreateObject("Scripting.Dictionary")
    R = Range("A2:G" & [A65000].End(xlUp).Row)

    For Each C In Range("A2", [A65000].End(xlUp))
        temp = C.Value
        If Not d1.exists(temp) Then
            d1.Add temp, temp
        End If
    Next C
    D = d1.keys    'Obtient les éléments

    ReDim Tbl(0)
    ReDim Preserve Tbl(4)
    temp = 0    'NCS
    temp1 = 0    'QS
    temp2 = 0    'QT
    NS = ""
    L1 = 1: L2 = 1
    
    For i = 0 To UBound(D)
        For j = LBound(R) To UBound(R)
            If D(i) = R(j, 1) Then
                L1 = j: L2 = j
                If R(j, 6) >= temp1 Then
                    temp11 = temp1
                    temp1 = R(j, 6)
                    'L1 = j
                    NS = NS & "|" & R(j, 2)
                End If
                If R(j, 7) >= temp2 Then
                    temp22 = temp2
                    temp2 = R(j, 7)
                    'L2 = j
                    NS = NS & "|" & R(j, 2)
                End If
            End If
        Next j
        Dim N$()
        N = Split(NS, "|")
        temp = Application.Max(UBound(N))

        Tbl(i + 1).Tab_1 = temp: Tbl(i + 1).Tab_2 = temp1: Tbl(i + 1).Tab_3 = temp2

    Next i
    Range("K2").Resize(d1.Count + 1) = Application.Transpose(d1.keys)
    'Range("K2").Resize(UBound(Tbl), 4) = Tbl
End Sub

 

[david84]

Re : Extraction de valeurs maximum

Re
Pas le temps ce soir (ni même peut-être demain) pour regarder.
Les résultats obtenus sont pourtant les mêmes que ceux marqué dans ton fichier...
J'ai du mal à comprendre ce que tu veux obtenir. Le plus simple est que tu fasses un fichier exemple explicite parce que sinon, je ne sais pas si j'arriverai à comprendre ton attente.
A+

 

[apt]

Re : Extraction de valeurs maximum

Bonsoir david,

Le problème réside dans cette ligne :

If Pl(j, 1) = temp(i) And Pl(j, 2) > NCS Then NCS = Pl(j, 2)

Comme ca le calcule se fera avec toutes les valeurs de NCS présentent pour un même objet.

Or, les valeurs NCS pour un même objet et sur lesquelles on devra faire le calcul, sont déterminées seulement après avoir trouvé la plus grande valeur de QS et aussi Qt.

Et voila une petite illustration de mon attente en PJ.

Merci.

 

[R@chid]

Re : Extraction de valeurs maximum

Bonsoir @ tous,
selon ce que j'ai compris,
c'est peut être pour :
WGH312D ==> 526 - 45.63% - 91.44% et pas ==> 721 - 45.63% - 91.44%
et pour :
WGH312A ==> 529 - 44.07% - 87.33% et pas ==> 928 - 44.07% - 87.33%
j’attends une explication si c'est possible???

Pour le résultat obtenu par le code de David, on peut le faire par "Consolider",
Mettre le curseur dans une cellule vide par exemple, AA27 devant le tableau du Résultat de David,
Aller sur l’Onglet Donnée ==> Consolider,
Définir comme sur l'image et "Ok",
Masquer les colonnes AC, AD, AE,
Tu peux trier les 2 tableaux par ordre alphabétique pour faire la comparaison

Amicalement

 

[apt]

Re : Extraction de valeurs maximum

Bonjour Rachid,

Pour l'objet WGH312D

- le max de QS = 45.63% ==> NCS = 721

- le max de QT = 91.44% ==> NCS = 526

- On prendra la plus grande valeur des NCS marquées (721 et 526), et NCS = 721

Pour l'objet WGH312A

- le max de QS = 44.07% ==> NCS = 928

- le max de QT = 87.33% ==> NCS = 529

- On prendra la plus grande valeur des NCS marquées (928 et 529), et NCS = 928

....

Pour l'objet PHDM0D

- le max de QS = 77.78% ==> NCS = 9

- le max de QT = 89.00% ==> NCS = 14

- On prendra la plus grande valeur des NCS marquées (9 et 14), et NCS = 14

Pour l'objet PHDM0A

- le max de QS = 100.00% ==> NCS = 8, 2, 2 (parce que trois valeurs max de QS=100%)

- le max de QT = 92.31% ==> NCS = 2

- On prendra la plus grande valeur des NCS marquées (8, 2, 2 et 2), et NCS = 8

Voila

 

[R@chid]

Re : Extraction de valeurs maximum

Bonjour,
Ok Bien compris,
je peux te réponde ce soir incha'allah...
Amicalement

 

[apt]

Re : Extraction de valeurs maximum

D'accord et encore merci.

Cordialement.