Maximum et minimum d'une sélection

[Johanna]

Bonjour,
Voila je dois rechercher dans une plage de cellules prise en paramètre, le maximum et le minimum et les mettre respectivement en bleu et en rouge.
Je vous envoie en fichier joint la tableau sur le quel je teste et voici mes fonctions. Visiblement il y a un porblème puisque ce la ne marche pas vraiment !!!
Merci d'avance pour votre aide !
Johanna

Sub Maximum(s As String)

Dim Cel As Range
Dim Val As Integer
Dim Adr As String
Val = -32767

Range(s).Select

For Each Cel In Selection

If Val < Cel Then
Val = Cel 'Valeur de la cellule
Adr = Cel.Address 'Adresse de la cellule
End If
Next

Range(Adr).Font.Bold = True
Range(Adr).Font.Color = RGB(0, 0, 255)
'La plus grande valeur est contenu dans la variable Val

End Sub

Sub Minimum(s As String)

Dim Cel As Range
Dim Val As Integer
Dim Adr As String
Val = 32767

Range(s).Select

For Each Cel In Selection

If Val > Cel Then
Val = Cel 'Valeur de la cellule
Adr = Cel.Address 'Adresse de la cellule
End If
Next

Range(Adr).Font.Bold = True
Range(Adr).Font.Color = RGB(255, 0, 0)
'La plus petite valeur est contenu dans la variable Val

End Sub

Sub Test()
Maximum ("A1:I15")
Minimum ("A1:I15")
End Sub

 

[Hervé]

bonjour

Je nai pas trop cherché à corriger ta macro, il etait plus rapide pour moi d'en refaire une, ne m'en veut pas :

Public Sub minimaxi()
Dim Minimum As Single
Dim maximum As Single
Dim Cel As Range

Minimum = CSng(Application.WorksheetFunction.Min(Selection))
maximum = CSng(Application.WorksheetFunction.Max(Selection))

For Each Cel In Selection
If Cel = Minimum Then Cel.Font.Bold = True: Cel.Font.ColorIndex = 3
If Cel = maximum Then Cel.Font.Bold = True: Cel.Font.ColorIndex = 5

Next cel

End Sub

Attention : val est une méthode déjà utilisé par excel , ne pas s'en servir comme nom de variable.

Salut
Hervé

 

[Lord Nelson]

Salut Johanna, Hervé,

Ta solution est très bien Hervé, mais comme je planchais sur les macros de Johanna, j'en étais arrivé à ceci avant de voir ta réponse :

Sub MaxiMini(s As String)

Dim Cel As Range
Dim ValMax As Double
Dim ValMin As Double
Dim Init As Boolean

For Each Cel In Range(s)
If IsNumeric(Cel) Then
If Init = False Then
ValMax = Cel
ValMin = Cel
Init = True
ElseIf ValMax < Cel Then
ValMax = Cel 'Valeur de la cellule
ElseIf ValMin > Cel Then
ValMin = Cel 'Valeur de la cellule
End If
End If
Next
For Each Cel In Range(s)
If IsNumeric(Cel) Then
If Cel = ValMax Then
Cel.Font.Bold = True
Cel.Font.Color = RGB(0, 0, 255)
ElseIf Cel = ValMin Then
Cel.Font.Bold = True
Cel.Font.Color = RGB(255, 0, 0)
Else
Cel.Font.Bold = False
Cel.Font.Color = 0
End If
End If
Next


End Sub

Sub Test()
MaxiMini "A1:I15"
End Sub

On garde l'idée du passage de paramètre entre les Sub Test et MaxiMini.
Ta solution présente l'avantage d'économiser une boucle en s'appuyant sur les fonctions Excel.

A+
Horatio

 

[Johanna]

Vraiment merci beaucoup !
Ton aide a été très efficace.
A bientôt peut-être...
Johanna

 

[Nanard]

Bonsoir Johanna,

sans boucle il y a pour la valeur mini:

Sub Mini ()
Range("A1:I15").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=A1=MIN($A$1:$I$15)" ' à adapter
Selection.FormatConditions(1).Font.ColorIndex = 3
End Sub

Et

Sub Maxi()
Range("A1:I15").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=A1=MAX($A$1:$I$15)" ' à adapter
Selection.FormatConditions(1).Font.ColorIndex = 3
End Sub

@ +

Nanard

 

[Johanna]

Vraiment merci à tous !
Vous êtes adorables !!! ;-)
Bonne fin de journée...
Johanna