Function PCT(t$)
Dim s, a(), i%, j%
s = Split(" " & t, "%")
ReDim a(UBound(s)) 'base 0
For i = 0 To UBound(s)
For j = Len(s(i)) - 1 To 1 Step -1
If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For
Next
Next
PCT = a 'vecteur ligne
End Function
Bonjour à vous 2,
Peut-être comme ceci.
Regarde les formats de cellules.
@+
Denis
Bonjour mcj1997, riton00, Denis132,
La solution de Denis est la bonne solution mais on peut aussi s'amuser avec cette fonction VBA :
Fichier joint.Code:Function PCT(t$) Dim s, a(), i%, j% s = Split(" " & t, "%") ReDim a(UBound(s)) 'base 0 For i = 0 To UBound(s) For j = Len(s(i)) - 1 To 1 Step -1 If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For Next Next PCT = a 'vecteur ligne End Function
A+
Il s'agit d'une fonction VBA, utilisez-la les yeux fermés, difficile de l'expliquer.Merci, mais j'aimerais bien comprendre car c'est plutôt bien.
??? Pas compris car la fonction VBA permet de créer la MFC.OK, toutefois dommage que la fonction VBA n'empêche pas la MFC.
Evidemment puisque c'est le but de la fonction.il faut bien en plus de la fonction VBA renseigner la MFC.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cible As Range, crit As Range
Set cible = [B2]
Set crit = [D2:D4]
If Intersect(Target, Union(cible, crit)) Is Nothing Then Exit Sub
Target.Select
cible.Interior.ColorIndex = xlNone 'RAZ
cible.Font.ColorIndex = xlAutomatic 'RAZ
If cible < PCT(crit(1))(0) Then
cible.Interior.ColorIndex = 3 'rouge
cible.Font.ColorIndex = 2 'police blanche
ElseIf cible >= PCT(crit(2))(0) And cible <= PCT(crit(2))(1) Then
cible.Interior.ColorIndex = 44 'orange
ElseIf cible >= PCT(crit(3))(0) Then
cible.Interior.ColorIndex = 43 'vert
End If
End Sub
Function PCT(t$)
Dim s, a(), i%, j%
s = Split(" " & t, "%")
ReDim a(UBound(s)) 'base 0
For i = 0 To UBound(s)
For j = Len(s(i)) - 1 To 1 Step -1
If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For
Next
Next
PCT = a 'vecteur ligne
End Function