Fonction personnalisée : Note numérique vers note alpha avec mise en forme

[Victor21]

Bonjour les amis

Une fonction personnalisée, incluant la mefc, serait-elle plus économe que cette formule + la MEFC, répétée plus de 600 fois :

=SIERREUR(CHOISIR(EQUIV(DECALER($N4;0;COLONNE()-9+EQUIV($J$1;$P$1:$AD$1;0));{0;1;2;3};1);"NA";"ECA";"AR";"A");"")

dans l'exemple que je joins (colonnes J, K et L).
Si oui, quelle serait-elle ?

D'avance, merci pour vos conseils et suggestions.

Edit : Complément MEFC

 

[Dranreb]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonjour
Déclare une RgAC As Range et fais en premier:

Set RgAC = Application.Caller

Remplace tous les Range(Application.Caller.Address) par RgAc d'une part,
mais surtout, étudie comment ton 3 doit être remplacé par une expression dépendant de RgAC.Row
Cordialement.

 

[david84]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonjour,

Pouvez-vous m'aider à remplacer :
Code :
Set d = c.Offset(3, Rang - 1)
de manière à adapter cette fonction à la ligne sur laquelle elle est utilisée ?
(Le 3 restreint l'utilistion de cette fonction sur la ligne 4, alors qu'elle doit être utilisée sur n'importe quelle ligne)

En fait, là encore, tu peux te servir de la propriété Caller en demandant non pas l'adresse mais la ligne de la cellule où tu valides la fonction :

ligne = Application.Caller.Row

Ensuite, dans le Offset, tu remplaces 3 par ligne-1, ce qui donne au final :

Function Note(Cellule As String, Plage As Range, Rang As Byte) As String
' David84 - XLD
   Dim c As Range, d As Range, Adrc As String, Adrd As String, ligne As Long
    Application.Volatile 'comme préconisé justement par Modeste
   With Plage
        Set c = .Find(Cellule, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then Adrc = c.Address
        ligne = Application.Caller.Row
        Set d = c.Offset(ligne - 1, Rang - 1)
        If Not d Is Nothing Then Adrd = d.Address
        Select Case d.Value
        Case Is = "-"
            Note = "Non évaluée"
            Range(Application.Caller.Address).Font.ColorIndex = 1
        Case Is = 0
            Note = "NA"
            Range(Application.Caller.Address).Font.ColorIndex = 3
        Case Is = 1
            Note = "ECA"
            Range(Application.Caller.Address).Font.ColorIndex = 46
        Case Is = 2
            Note = "AR"
            Range(Application.Caller.Address).Font.ColorIndex = 32
        Case Is = 3
            Note = "A"
            Range(Application.Caller.Address).Font.ColorIndex = 10
        Case Else
            Range(Application.Caller.Address).Font.ColorIndex = 1
            Note = "Erreur"
        End Select
    End With
End Function

Est-ce bien ce que tu voulais obtenir ?
A+
Edit : désolé Bernard, je n'avais pas vu ton message.

 

[Victor21]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonjour, David, Bernard, bonjour à tous

Avec votre suggestion, et l'appel ainsi :

=note($J$1;$P$1:$AD$1;COLONNE(A:A))

J'obtiens exactement ce que je souhaitais
Va falloir que je m'y mette... sérieusement !
Mais Dieu que le chemin du retour depuis la Béotie est long, et semé d'embuches

Un grand merci à tous les deux de m'avoir dépanné, et de m'avoir fait découvrir Application.caller.

 

[Fo_rum]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonsoir,

pour ceux qui calent sur "Caller", une autre fonction avec une variable (ligne) en plus :

Function Note(Cellule As String, Plage As Range, ligne As Long, Rang As Byte) As String
  Application.Volatile 'comme préconisé justement par Modeste
  n = Array("-", 0, 1, 2, 3, 4)
  r = Array("Non évalué", "NA", "ECA", "AR", "A", "Erreur")
  c = Array(1, 3, 46, 32, 10, 1)
  k = Cells(ligne, Plage.Find(Cellule, LookIn:=xlValues, lookat:=xlWhole).Column + Rang - 1)
  For x = 0 To 5
    If k = n(x) Then
      Note = r(x)
      Range(Application.Caller.Address).Font.ColorIndex = c(x)
      Exit For
    End If
  Next
End Function

Dans les codes précédents, il me semble qu'il y a des lignes inutiles (If Not ...)

Avec de nombreux cas, le temps peut "durer" et comme il a été dit, une évènementielle pourrait mieux convenir.

 

[Victor21]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonsoir, Fo_rum

Merci pour ta proposition.
Effectivement, sur plus de 600 cellules, le calcul n'est pas instantané.
Je vais tenter d'écrire la Worksheet_Change pour comparer.

 

[david84]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Re
J'ai épuré de mon côté. Dis-nous si tu gagnes en temps de traitement :

Function Note(Cellule As String, Plage As Range, Rang As Byte) As String
' David84 - XLD
   Dim c As Range, Adrc As String, ligne As Long
    Application.Volatile 'comme préconisé justement par Modeste
    ligne = Application.Caller.Row
    Set c = Plage.Find(Cellule, LookIn:=xlValues, lookat:=xlWhole).Offset(ligne - 1, Rang - 1)
    Adrc = c.Address
    Select Case c.Value
    Case Is = "-"
        Note = "Non évaluée"
        Range(Application.Caller.Address).Font.ColorIndex = 1
    Case Is = 0
        Note = "NA"
        Range(Application.Caller.Address).Font.ColorIndex = 3
    Case Is = 1
        Note = "ECA"
        Range(Application.Caller.Address).Font.ColorIndex = 46
    Case Is = 2
        Note = "AR"
        Range(Application.Caller.Address).Font.ColorIndex = 32
    Case Is = 3
        Note = "A"
        Range(Application.Caller.Address).Font.ColorIndex = 10
    Case Else
        Range(Application.Caller.Address).Font.ColorIndex = 1
        Note = "Erreur"
    End Select
End Function

Je t'ai proposé une fonction parce que c'est ce que tu voulais mais peut-être faut-il comparer avec une évènementielle pour voir.
A mon avis, une évènementielle te fera gagner du temps car elle ne jouera que sur la cellule subissant l’évènement tandis qu'avec une fonction volatile, c'est toutes les cellules qui sont recalculées à chaque modification.
A+

 

[Fo_rum]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Re

Re
J'ai épuré de mon côté...

encore un petit effort (Adrc)

Ci-joint, un exemple de macro évènementielle (avec le support précédent).
Pour comparer, fais 2 fichiers sinon la fonction est lancée avec la macro.

 

[david84]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Re

encore un petit effort (Adrc)

Effectivement !

Set c = Plage.Find(Cellule, LookIn:=xlValues, lookat:=xlWhole).Offset(ligne - 1, Rang - 1)

suffit.
A+

 

[Victor21]

Re : Fonction personnalisée : Note numérique vers note alpha avec mise en forme

Bonjour, Fo_rum, David

David, je te remercie pour tes efforts qui m'ont vraiment donné envie d'approfondir les fonctions personnalisées.

Fo_rum, Bernard et toi avez bien raison de proposer une procédure événementielle ! Il est clair qu'on y gagne en instantanéité, et probablement aussi en poids : environ 900 cellules sont concernées.

Je vais donc opter pour cette dernière solution, après avoir adapté ton code pour qu'il dépende du nom en J1, et peut-être préférer un calculate, les notes à partir de la colonne P étant le résultat d'un calcul.

En tous cas, merci à vous tous.