Discussion :

[phil69126]

Bonjour

J'ai un tableau de noms d'élèves et j'ai sur eux des informations chiffrées. Exemple pour Dupont, je l'ai noté en performance sur 4, idem en projet, idem en Connaissances, etc.(5 notes de 1 à 4)
J'ai récupéré un tableau dans lequel si j'insère un chiffre il me fait correspondre une appréciation. Jusqu'à la c'est très bien. Mais d'une part l'appréciation apparait en noir et blanc, et d'autre part si je veux coller l'ensemble des chiffres cela ne marche pas. Je suis obligé de les rentrer un par un. Y a t'il une solution?
En vous remerciant d'avance soit en m'orientant mieux dans le blog soit en répondant à mes questions.
Cordialement
Essai Correspondance chiffres appréciations 4C paysage.xlsm

[unparia]

Bonjour
Ce n'est pas la première fois que je te dis (en vain !) de bien vouloir te conformer à ceci :
https://www.developpez.net/forums/d8...s-discussions/
En vain !
Je n'ouvre et n'ouvrirai jamais un classeur tiers
Je n'ai donc pas ouvert le tien et vais me contenter de répondre par un exemple à ce que je crois avoir deviné -->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
corresp = Array("", "mauvais", "passable", "moyen", "bon", "très non", "excellent")
 note = 2
 MsgBox note & " ==> " & corresp(note)
 note = 5
 MsgBox note & " ==> " & corresp(note)

[phil69126]

Bonjour
Merci d'avoir pris le temps de me lire. Mais par rapport aux pièces jointes, c'est, pour beaucoup de gens inexpérimentés, le seul moyen d apporter une solution à leur problème. Dans le cas présent le code que tu me communiques ne m'aide pas beaucoup car même après avoir essayé de le coller en tant que nouvelle macro, rien ne fonctionne. Alors si je comprends bien ta démarche un ignare en informatique ne peut avoir sa place dans ce site. Je le conçois mais a qui puis je m'adresser pour compléter mon tableau.
De plus il y a d'autres paramètres qui rentrent en ligne de jeu. La mise en page qui peut ne pas s'adapter au nouveau programme, obtenir une correspondance chiffres mais avec un texte couleur sur un fond aussi coloré, une saisie pratique "copier tous les chiffres et les coller en une seule fois". Pour moi une vue d'ensemble est nécessaire. Mais là encore j'accepte tes arguments -peur de virus - ne pas rendre une solution toute faite etc.
Bilan des courses je reste avec mon problème et toi avec ton savoir. Je ne suis pas vexé et en colère mais déçu de ne pas progresser. Merci quand même et j'essayerai d'adopter tes conseils de procédure mais avec mon niveau d'informatique je ne pense pas qu'ils me soient d'un grand secours.
Cordialement

[Theze]

Bonjour,

Et dans Excel, tu as la fonction Choisir() qui retourne la valeur en position de l'index !
En partant de l'exemple de unparia (mis à part "très non" ) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
=CHOISIR(3;"mauvais";"passable";"moyen";"bon";"très bon";"excellent")

[phil69126]

Bonjour
Voilà ce que j'ai dans mes données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Application.Intersect(Target, Range("b3:x45")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    On Error GoTo Fin
        Application.EnableEvents = False
        Target = WorksheetFunction.HLookup(Target, Range("b3:f4"), 2, 0) 'rechercheH
    End If
    Application.EnableEvents = True
Exit Sub
Fin: MsgBox ("Ce code n'existe pas !")
    Target.ClearContents
    Application.EnableEvents = True
End Sub

[phil69126]

Merci à Thèse mais le problème reste identique.

[Docmarti]

Bonjour.
Pour copier la valeur et les couleurs, il vaut mieux utiliser Copy.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Application.Intersect(Target, Range("b3:x45")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
 
        Application.EnableEvents = False
        what = Target.Value
        Set r = Range("b3:f4").Find(what, , , xlWhole)
        If r Is Nothing Then
         MsgBox ("Ce code n'existe pas !")
        Else
         r.Offset(1).Copy Target
        End If
    End If
 
    Application.EnableEvents = True
End Sub