[VBA/Excel] Trouver les grandes valeurs d'un

Bonjour

Apparement, il faudrait que tu appelles un 3° tableau (j'ai essayé une petite maquette)

dim tablo()  

ReDim Preserve tablo(1 to UBound(D), 1 to UBound(R, 2) - 1)  

mais je ne comprends pas bien ton UBound(R, 2): j'aurais tendance à écrire Ubound(R) mais je n'ai pas trop regardé le but ton code, donc...

Michel

Type tabloStructure 
  Tab_1 As Integer 
  Tab_2 As Integer 
  Tab_3 As Integer 

End Type 
Sub test2() 
Dim monTablo() As tabloStructure 

ReDim monTablo(0) 
ReDim Preserve monTablo(3) 

monTablo(1).Tab_1 = 4 
monTablo(2).Tab_2 = 5 
monTablo(3).Tab_3 = 10 

MsgBox monTablo(1).Tab_1 
MsgBox monTablo(1).Tab_2 
MsgBox monTablo(1).Tab_3 
End Sub 

c'est une proposition, comme l'a fait remarquer michelM

moi aussi je pense qu'il te faut trois tableaux.

est comme tu n'as pas le droit de redimensionné un tableau triple.
il faut rusé avec un tableau structuré.

je t'ai laissé un exemple.

A+

Bonsoir à tous,

Pour ceux qui sont intéressés par ce sujet, voila un code qui fonction, et ne reste qu'à rectifier la mise en forme :

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

:)

Tu définis D comme type Variant pour ensuite le redéfinir en tableau avec le mot clé Preserve.
Preserve est utilisé pour garder les données d'un tableau tout en changeant sa taille.
Essaie de définir D la première fois en tant que tableau et non en type Variant, cela devrait fonctionner.

Bonsoir linkcr15,

Et :

Dim D()

ne suffisait-elle pas pour dire à Excel que c'est un tableau, ou il y a d'autres définitions ?

Bonjour,

Voila un exemple pour le test :

http://cjoint.com/?BEFiEIj1y5Z

Salut,

Personne n'a essayer cet exemple :

http://cjoint.com/?BEFiEIj1y5Z

Bonsoir,

J'attends toujours une solution.

Merci.

Bonsoir,

perso je n'ai pas d'erreur sur le redim de ton fichier exemple, vu que tu l'as renommé tbl...

Sur ton post 1 :
D = d1.Keys 'Obtient les éléments
ReDim Preserve D(1 To UBound(D), 1 To UBound(R, 2) - 1)
D n'a qu'une seule dimension et tu cherches à redimensionner la 2nde.

Dans ton code ça passe mais :
D = d1.Keys 'Obtient les éléments, D a 1 dimension
ReDim Preserve Tbl(1 To UBound(D), 1 To UBound(R, 2) - 1) , Tbl a 2 dimensions
Tbl = D ' Tbl repasse à 1 dimension

Puisque tu as les formules, pourquoi ne fais-tu pas application.max(....) ou evaluate(formule) ?

eric

Bonsoir Bidouilleu_R, eriic

Bidouilleur : Ou est le fichier exemple pour voir ?

eriic : C'est ça solutionne mon problème, qu'elle soit la bienvenu

;)

Re,

eriiic : j'aimerais avoir les deux plus grandes valeurs pour la colonne F et G pour un même objet.

Pour la colonne B, elle ne sera déterminée qu'après avoir eu le max de la colonne F et G et connaitre les valeurs de NCS correpondantes pour extraire la plus grande valeur entre eux.

Voila !

Bonsoir,

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

Re,

Au post 15 tu n'as pas mis la définition du type de structure pour tabloStructure.

Pour la colonne B, elle ne sera déterminée qu'après avoir eu le max de la colonne F et G et connaitre les valeurs de NCS correpondantes pour extraire la plus grande valeur entre eux
Les formules en K sont fausses ou j'ai raté qcq chose ?
C'est pour brouiller les pistes ?

Les objets sont toujours regroupés ?
Peut-on trier pour s'en assurer et qu'ils soient déjà classés ??

eric

Abandon du suivi, comme tu n'as pas la politesse de signaler poster sur plusieurs forums.
Voir ici
eric

Elle suffisait mais je sais que certaines fonctions ne fonctionne pas quand on définit le paramètre en type Variant (le type par défaut). Essaie donc de le définir en tant que tableau avant le redéfinition, cela réglera peut-être ton problème (je ne peux pas tester désolé).