Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

[CampaSC]

Bonjour,

Je recherche une fonction ou une macro qui:
1°) Trouve la plus petite des valeurs situées sur des cellules non-adjacentes dans une même colonne.
2°) Renvoie la référence (absolue ou relative) de la cellule correspondante.

Merci pour votre aide,
CampaSC

 

[mapomme]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

(re)Bonjour à tous,

Si la question change sans cesse, comment répondre efficacement?

Un essai avec une fonction personnalisée:

Cette fonction s'écrit :
=mincorr(A1;A3:A4;A7) ou
=mincorr(A1;A3:A4;A7;B9)

• Si les références sont toutes dans la même colonne, on retourne le minimum de toute les références.
• Si les références sont toutes dans la même colonne sauf la dernière, on renvoie la valeur de la colonne correspondant à cette dernière référence et à la ligne du premier minimum des n-1 premières références.

Si on veut renvoyer non pas le minimum (si toutes les référence sont dans la même colonne!) mais le numéro de ligne du minimum alors remplacer dans le code de la fonction MinCorr = Min par MinCorr = j

Le code:

Option Explicit

Function MinCorr(ParamArray X())
' si toutes les références sont unicolonnes et
' de même colonne => renvoi du minimun de toutes les références

' si les n-1 références sont unicolonnes et
' de même colonne et si dernière référence de colonne
' différente => renvoi de la valeur de la dernière colonne
' de la ligne du minimum des n-1 premières référence
' sinon => erreur

Dim Min, i, j, xCell As Range

'Test validité
j = X(LBound(X)).Column
For i = LBound(X) To UBound(X) - 1
  If X(i).Column <> j Or X(i).Columns.Count > 1 Then On Error GoTo FIN
Next i

' Calcul du minimum
Min = 10 ^ 99
For i = LBound(X) To UBound(X) - IIf(X(LBound(X)).Column = X(UBound(X)).Column, 0, 1)
  For Each xCell In X(i)
    If xCell < Min Then
      Min = xCell.Value
      j = xCell.Row
    End If
  Next xCell
Next i
  
If X(LBound(X)).Column = X(UBound(X)).Column Then
  MinCorr = Min   '<= remplacer min par j pour le N° de ligne
Else
  MinCorr = Application.Caller.Parent.Cells(j, X(UBound(X)).Column)
End If
Exit Function

FIN:
MinCorr = Application.WorksheetFunction.Ln(Cells(-1, -1))
End Function

 

[mapomme]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

(re)Bonjour à tous,

Un exemple avec le dernier fichier de CampaSC et le renvoi par la fonction MinCorr du numéro de ligne et non pas du minimum (quand toutes les réf. sont dans la même colonne)

 

[CampaSC]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Edit...Edit

 

[CampaSC]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Bonjour Mapomme et désolé pour tous les changements en cours de route...
Ta fonction personnalisée me paraît résoudre parfaitement mon problème. Par contre, comment faire pour y faire appel dans ma macro VBA ?

 

[mapomme]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

(re)Bonjour,

Une fonction qui retourne soit le minimum soit la ligne du 1ier minimum.

=MinCouleur(A1:A18;A5) retourne le minimum des cellules A1:A18 de même fond que la cellule A5.

=MinCouleur(A1:A18;A5;1) retourne la ligne du minimum des cellules A1:A18 de même fond que la cellule A5.

Function MinCouleur(Plage As Range, CelluleCouleurRef As Range, Optional MinOuNum)
Dim Min, i, j, xCell As Range
Min = 10 ^ 99: j = -1
For Each xCell In Plage
  If xCell.Interior.ColorIndex = CelluleCouleurRef.Interior.ColorIndex Then
    If xCell < Min Then
      Min = xCell.Value
      j = xCell.Row
    End If
  End If
Next xCell
If j = -1 Then MinCouleur = "" Else MinCouleur = IIf(IsMissing(MinOuNum), Min, j)
End Function

 

[mapomme]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

(re)Bonjour,

Avec un exemple d'utilisation de la fonction en VBA (Sub Test)

Sub Test()

Cells(8, "f").Value = MinCouleur(Range(Cells(2, "a"), Cells(19, "a")), Cells(5, "a"))
Cells(9, "f").Value = MinCouleur(Range(Cells(2, "a"), Cells(19, "a")), Cells(5, "a"), 1)

End Sub

 

[CampaSC]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Merci Mapomme, j'ai adapté ta fonction MinCouleur pour qu'elle fonctionne avec ma macro et ça marche. Nickel !

 

[ROGER2327]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Bonjour à tous

Je recherche une fonction ou une macro qui:
1°) Trouve la plus petite des valeurs situées sur des cellules non-adjacentes dans une même colonne.
2°) Renvoie la référence (absolue ou relative) de la cellule correspondante.

Une fonction matricielle personnalisée qui fait ça (et même un peu plus) :​

Function minsp(ParamArray prm() As Variant)
Application.Volatile 'facultatif

Dim i&, j&, k&, v(), tmp, adr$, cel As Range, plg As Range
    For i = 0 To UBound(prm)
        Set plg = prm(i)
        For Each cel In plg.Cells
            k = k + 1
            ReDim Preserve v(1 To 2, 1 To k)
            If IsEmpty(cel) Then v(1, k) = "" Else v(1, k) = cel.Value
            v(2, k) = cel.Address(0, 0)
        Next
    Next
    For i = 1 To k - 1
        tmp = v(1, i)
        For j = i + 1 To k
            If tmp > v(1, j) Then
                v(1, i) = v(1, j): v(1, j) = tmp: tmp = v(1, i)
                adr = v(2, i): v(2, i) = v(2, j): v(2, j) = adr
            End If
        Next
    Next
    minsp = WorksheetFunction.Transpose(v)
End Function

Voir la mise en œuvre dans le classeur joint.​

ROGER2327
#6026

Mercredi 18 Gidouille 139 (Visitation de Mère Ubu - fête Suprême Seconde)
14 Messidor An CCXX, 6,9588h - lavande
2012-W27-1T16:42:04Z

 

[CampaSC]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Oui Roger2327, cela marche aussi...Cependant j'ai un peu plus de mal à comprendre comment fonctionne la macro ( je ne suis pas vraiment expérimenté en VBA ^^)
Comment dois-je faire pour avoir non pas la plus petite valeur mais la référence de la cellule ?

 

[ROGER2327]

Re : Fonction similaire à PETITE.VALEUR() avec des cellules non-adjacentes

Re...

Oui Roger2327, cela marche aussi...Cependant j'ai un peu plus de mal à comprendre comment fonctionne la macro ( je ne suis pas vraiment expérimenté en VBA ^^)
Comment dois-je faire pour avoir non pas la plus petite valeur mais la référence de la cellule ?

La "macro" est une fonction matricielle c'est-à-dire une fonction qui renvoie un tableau de valeurs et non pas une valeur unique. Ce tableau possède deux colonnes et autant de lignes qu'il y a de cellules à traiter. Dans l'exemple du classeur joint, on veut traiter les cellules B6;B8;B10;B14;B17:B18, soit six cellules. Donc la fonction

=minsp(B6;B8;B10;B14;B17:B18)

renvoie un tableau à six lignes et deux colonnes.

Par conséquent, si l'on veut afficher le tableau entier, on sélectionne une plage à six lignes et deux colonnes (E7:F12 dans le classeur joint), on saisit la formule ci-dessus, puis on valide par Ctrl Maj Entrée.

Si l'on ne veut afficher qu'un élément du tableau, on utilise la fonction Excel INDEX en complément de la fonction minsp. Vous voulez par exemple récupérer l'adresse de la cellule contenant la plus petite valeur (B10 dans notre exemple). Cette adresse est dans la deuxième colonne de la première ligne du tableau renvoyé par minsp. On l'obtiendra par la formule

=INDEX(minsp($B$6;$B$8;$B$10;$B$14;$B$17:$B$18);1;2)

à valider normalement par Entrée puisqu'on ne veut pas afficher un tableau, mais seulement une valeur unique.
(C'est ce qui est fait dans la cellule J7 du classeur joint, à la différence près que les paramètres 1 et 2 sont pris respectivement dans les cellules H7 et J6.)

Dans le tableau I7:J12, vous verrez comment obtenir individuellement chaque valeur du tableau renvoyé par minsp.

J'ai fait le même travail pour le traitement des cellules X8:X10;Y7:AA7;Z9:AA9;Y11:Y14;AA11:AA14. Les résultats sont dans les tableaux AC7:AD22 et AG7:AH22.


Pour donner un autre exemple, j'ai écrit une fonction minsp2 qui renvoie un tableau à trois colonnes : la première contient les valeurs classées en ordre croissant (comme minsp). La deuxième (respectivement troisième) contient le numéro de ligne (resp. colonne) correspondant. Cette fonction s'utilise de la même manière que minsp : voir les tableaux M7:O12 et R7:T12 pour le premier exemple, AK7:AM22 et AP7:AR22 pour le deuxième exemple.

Enfin, une procédure (nommée toto) permet de remplir la plage AT2:AT4. Code :​

Sub toto()
Dim plage As Range, table()
    Set plage = Feuil1.Range("$X$8:$X$10,$Y$7:$AA$7,$Z$9:$AA$9,$Y$11:$Y$14,$AA$11:$AA$14")
    table = minsp2(plage)
    Feuil1.Range("AT2").Resize(3, 1).Value = WorksheetFunction.Transpose(table)
End Sub

Elle devrait vous permettre de voir comment utiliser minsp2 dans une procédure VisualBasic.​

Bon courage.


ROGER2327
#6030

Mercredi 18 Gidouille 139 (Visitation de Mère Ubu - fête Suprême Seconde)
14 Messidor An CCXX, 9,2909h - lavande
2012-W27-1T22:17:54Z