Filtrer sans doublons avec la plus grande valeur

[apt]

Bonsoir à tous,

J'aimerais en VBA, avoir un filtre dans feuil2, d'un tableau sans doublons avec la plus grande valeur de chaque nom "Objet".

Voir l'exemple en PJ.

http://cjoint.com/?BEya4AID2D1

Merci.

 

[Dranreb]

Re : Filtrer sans doublons avec la plus grande valeur

Bonjour.
Il se trouve que ma fonction Récap le sort très facilement exactement comme vous le voulez !
Cordialement.

 

[BOISGONTIER]

Re : Filtrer sans doublons avec la plus grande valeur

Bonjour,

Sub MaxItems()
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    tmp = c.Value
    If d.exists(tmp) Then
      If c.Offset(, 5) > d(tmp) Then d(tmp) = c.Offset(, 5)
    Else
      d(tmp) = c.Offset(, 5)
    End If
    If d2.exists(tmp) Then
      If c.Offset(, 6) > d2(tmp) Then d2(tmp) = c.Offset(, 6)
    Else
      d2(tmp) = c.Offset(, 6)
    End If
  Next c
  Sheets("feuil2").[e2].Resize(d.Count, 1) = Application.Transpose(d.keys)
  Sheets("feuil2").[f2].Resize(d.Count, 1) = Application.Transpose(d.items)
  Sheets("feuil2").[g2].Resize(d.Count, 1) = Application.Transpose(d2.items)
End Sub

JB

 

[apt]

Re : Filtrer sans doublons avec la plus grande valeur

Bonjour Dranreb, JB

Dranreb > Il me faut un peu du temps pour comprendre ta fonction 😉

JB > ton code marche très bien, sauf s'il y a des erreurs dans les colonnes, genre #DIV/0!, ça déclenche une erreur 😕

Voir PJ.

Merci.

 

[Dranreb]

Re : Filtrer sans doublons avec la plus grande valeur

Dranreb > Il me faut un peu du temps pour comprendre ta fonction

Ne manquez pas de me signaler ce qui manquerait dans les commentaires en tête pour savoir comment l'utiliser.
C'est forcément clair pour moi, mais je suis ouvert à une rédaction différente du mode d'emploi. On pourrait par exemple ajouter ce commentaire tout en tête:

Rem. Voir derrière l'instruction "Function Récap(…" les paramètres Argument et Charges à spécifier pour utiliser cette fonction.

Et mettre un "C" majuscule à "Charges" dans le commentaire suivant, actuellement en tête.
À +

 

[BOISGONTIER]

Re : Filtrer sans doublons avec la plus grande valeur

Bonsoir,

voir pj

Sub MaxItems()
    Set d = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    For Each c In Range("a2", [a65000].End(xlUp))
        tmp = c.Value
        If c.Offset(, 1) = 0 Then tmp2 = 0 Else tmp2 = c.Offset(, 5)
        If d.exists(tmp) Then
            If tmp2 > d(tmp) Then d(tmp) = tmp2
        Else
            d(tmp) = tmp2
        End If
        If c.Offset(, 1) = 0 Then tmp3 = 0 Else tmp3 = c.Offset(, 6)
        If d2.exists(tmp) Then
            If tmp3 > d2(tmp) Then d2(tmp) = tmp3
        Else
            d2(tmp) = tmp3
        End If
    Next c
    Sheets("feuil2").[e2].Resize(d.Count, 1) = Application.Transpose(d.keys)
    Sheets("feuil2").[f2].Resize(d.Count, 1) = Application.Transpose(d.items)
    Sheets("feuil2").[g2].Resize(d.Count, 1) = Application.Transpose(d2.items)
End Sub

JB

 

[apt]

Re : Filtrer sans doublons avec la plus grande valeur

Bonjour Dranreb, JB

Ne manquez pas de me signaler ce qui manquerait dans les commentaires en tête pour savoir comment l'utiliser.

D'accord.

Merci bien.

 

[apt]

Re : Filtrer sans doublons avec la plus grande valeur

Bonjour JB,

Une petite correction a demandé.

J'aimerais que la valeur de la première colonne ne soit déterminé qu'après reconnaitre la grande valeur de la colonne F et G.

Exemple en PJ.

Merci.

 

[apt]

Re : Filtrer sans doublons avec la plus grande valeur

Bonsoir,

Un essai avec des tableaux (Pas de succès encore) :

Sub GrandesValeurs()
    Dim D() As Variant, R() As Variant


    Set d1 = CreateObject("Scripting.Dictionary")
    R = Range("A2:E" & [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 = Application.Transpose(d1.keys)
    
    'ICI ERREUR !!!
    ReDim Preserve D(UBound(D), UBound(R, 2) - 1)
    
    temp = 0    'NCS
    temp1 = 0    'QS
    temp2 = 0    'QT

    For i = LBound(D) To UBound(D)
        For j = LBound(R) To UBound(R)
            If D(i, 1) = R(j, 1) Then
                L1 = j: L2 = j
                If R(j, 4) > temp1 Then
                    temp1 = R(j, 4)
                    L1 = j
                End If
                If R(j, 5) > temp2 Then
                    temp2 = R(j, 5)
                    L2 = j
                End If
            End If
        Next j
        If R(L2, 2) > R(L1, 2) Then temp = R(L2, 2) Else temp = R(L1, 2)
        D(i - 1, 2) = temp: D(i - 1, 3) = temp1: D(i - 1, 4) = temp2
    Next i
    MsgBox "Val QS = " & temp1 & ", à la ligne L1=" & L1 & vbCrLf & _
           "Val QT = " & temp2 & ", à la ligne L2=" & L2 & vbCrLf & _
           "Val NCS = " & temp

    Range("G2").Resize(UBound(D), 4) = D
End Sub

 

[apt]

Re : Filtrer sans doublons avec la plus grande valeur

Bonsoir,

Une correction possible ?

Merci d'avance.