Minimum conditionnel en VBA

pingouinal

XLDnaute Occasionnel
Bonjour,

Dans le fichier ci-joint, je cherche par macro à obtenir la valeur minimum correspondant à un groupe et à l'attribuer à toutes les références de ce groupe.

Un référence est par exemple GXXXX756 et un groupe est une référence à laquelle on a enlevé les deux derniers chiffres. Donc les références GXXXX756 et GXXXX757 appartiennent au groupe GXXXX7.

J'ai mis en colonne F le résultat que je souhaite obtenir et en colonne G la manière dont je l'obtiens par formule matricielle (ça sera peut-être plus clair que mon explication ^_^' ). Mon problème est que je n'arrive pas à transposer cette formule dans mon code VBA.

D'avance merci à tous ceux qui tenteront de m'aider et n'hésitez pas à me dire si il faut des explications plus claires.
 

Pièces jointes

  • Book2.xlsx
    9.5 KB · Affichages: 33
  • Book2.xlsx
    9.5 KB · Affichages: 37
  • Book2.xlsx
    9.5 KB · Affichages: 39

Efgé

XLDnaute Barbatruc
Re : Minimum conditionnel en VBA

Bonjour pingouinal

Une proposition:
La liste n'as pas besoin d'être triée.
Le résultat est en $J$3.
VB:
Sub test()
Dim i&, Grp$, D As Object, T As Variant
Set D = CreateObject("Scripting.dictionary")

With Sheets("Sheet1")
    T = .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(3)(1, 2))
End With

For i = LBound(T, 1) To UBound(T, 1)
    Grp = Left(T(i, 1), Len(T(i, 1)) - 2)
    If Not D.exists(Grp) Then
        D(Grp) = T(i, 2)
    Else
        If T(i, 2) < D(Grp) Then D(Grp) = T(i, 2)
    End If
Next i

For i = LBound(T, 1) To UBound(T, 1)
    Grp = Left(T(i, 1), Len(T(i, 1)) - 2)
    T(i, 2) = D(Grp)
Next i

Sheets("Sheet1").Cells(3, 10).Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub

Cordialement
 

job75

XLDnaute Barbatruc
Re : Minimum conditionnel en VBA

Bonjour pingouinal, salut Efgé,

Une solution VBA simple est d'entrer vos formules matricielles :

Code:
Sub Résultat()
Dim resu As Range
With [B3:B10] 'à adapter
  .Name = "Base"
  .Offset(, 1).Name = "Valeur"
  Set resu = .Offset(, 3) 'decalage de 3 colonnes
End With
With resu(1)
  .FormulaArray = "=MIN(IF(LEFT(Base,LEN(Base)-2)=LEFT(RC[-3],LEN(RC[-3])-2),Valeur))"
  .AutoFill resu
End With
resu = resu.Value 'supprime les formules
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Book(1).xlsm
    19.2 KB · Affichages: 44

Discussions similaires

Statistiques des forums

Discussions
312 358
Messages
2 087 585
Membres
103 601
dernier inscrit
ASLEROY