Recherche macro ou fonction

[Raimana]

Bonjour,
Je cherche une macro ou une fonction me permettant ceci :
-soit un fichier d'élève avec la date du jour (colonne A), son nom (colonne B), son prénom (colonne C), son école (colonne D) et sa classe (colonne E)
- je voudrai que, indépendamment de la saisie, dans la colonne F, s'inscrive
automatiquement le niveau scolaire de l'élève : Maternelle, Elémentaire,
Collège, Lycée, Université, et Préscolaire
_ tout en sachant que pour certaines classes la saisie peut-être : CM1,
CM1/CM2, CM1 / CM2, CM1 Tiare, CM1Tiare, CM1 TIARE !!!!

Compte tenu de ces éléments, je pensais à une macro sous forme de fonction
commençant donc par "Function".

J'ai épuisé toutes mes ressources sans trouver de solutions.
Merci de votre aide,
Raimana

 

[pierrejean]

Re : Recherche macro ou fonction

bonjour Raimana

et bienvenue sur XLD

Et pour quelqu'un qui ne fait pas partie de l'Education Nationale ou trouve-t-il l'equivalence Classe -> Niveau scolaire ?

Avec un petit fichier exemple (sans données confidentielles mais avec l'equivalence ) on pourrait surement aller un peu plus loin

 

[jp14]

Re : Recherche macro ou fonction

Bonjour
Bonjour Pierrejean

Ci dessous une macro évènementielle qui met à jour la colonne F en recherchant les valeurs déjà entrées.
Quand on ajoute une valeur dans la colonne E, la macro recherche si cette valeur existe dans la colonne et si elle est trouvé recopie la donnée de la colonne adjacente.
Elle est facilement transposable, en rouge les zones à modifier.

Option Explicit
Dim flag As Byte

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellule As Range
Dim dl1 As Long

If flag = 1 Then Exit Sub
 If Target.Count > 1 Then Exit Sub
 If Target.Column <>[COLOR="Red"] 5 [/COLOR]Then Exit Sub ' colonne qui contient la classe 
 If Target.Value = "" Then Exit Sub
 flag = 1
 With Worksheets(ActiveSheet.Name)
  For Each cellule In .Range([COLOR="Red"] "e2:e" & .Range("e[/COLOR]65536").End(xlUp).Row)
    If cellule.Row <> Target.Row Then
        If Target.Value = cellule.Value Then
            .Range([COLOR="Red"]"f"[/COLOR] & Target.Row) = .Range(cellule.Address).[COLOR="Red"]Offset(0, 1)[/COLOR].Value
            flag = 0
            Exit Sub
        End If
     End If
 Next cellule
End With
flag = 0
End Sub

 

[Raimana]

Re : Recherche macro ou fonction

Bonjour et merci d'avoir répondu,
Il faut que je "dégraisse" pas mal le fichier (actuellement 1100 Ko) et je vous l'envoie.
A+

 

[Raimana]

Re : Recherche macro ou fonction

Bonsoir JP14, bonsoir Pierrejean,

Ci-joint le fichier en question ... merci encore pour votre aide

 

[pierrejean]

Re : Recherche macro ou fonction

bonjour Raimana

Une Approche par fonction personnalisée

Les equivalences ont été reportées sur une feuille additionelle

Toutes n'ont pu etre traitées en approximation

Teste et dis nous

 

[jp14]

Re : Recherche macro ou fonction

Bonjour Raimana
Bonjour Pierrejean

Ci joint un fichier avec des macros pour résoudre le problème posée.

Une macro dans le module1 qui met à jour l'ensemble de la feuille, à lancer avec le bouton.
Des macros évènementielle dans la feuille:
Une macro pour créer automatiquement une liste de validation sans doublons et triées
Private Sub Worksheet_SelectionChange(ByVal Target As Range), macro qui peut être utilisé pour la colonne école.
La deuxième est celle indiquée ci dessus, macro qui utilise les données déjà entrée (apprentissage)

A tester

JP

 

[Raimana]

Re : Recherche macro ou fonction

Bonjour PierreJean, Bonjour JP14,

Voici la dernière macro que l'on me propose. Apparemment tout fonctionne sauf que je suis obligé de refaire toute la saisie de la colonne E. Auriez-vous une idée pour éviter cet inconvénient ?

Merci encore,
Raimana

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 8 Or Target.Count > 1 Then Exit Sub
'le 5 c'est pour la colonne où tu saisis donc colonne E pour la classe
'le >1 c'est pour empêcher une saisie multiple
If Target.Value = "" Then Range("F" & Target.Row).Value = ""
'Modif : si tu vides la cellule de la colonne E, cela vide la cellule correspondante de F
Application.EnableEvents = False 'pour que cela ne "scintille" plus
If IsNumeric(Target) = False Then Target.Value = UCase(Target.Value)
'Modif : les saisies dans la feuille ne sont plus sensibles à la casse
' tout passe en majuscule

Select Case Left(Target.Value, 2)
'Modif : ne considère que les 2 caractères de gauche de la saisie
Case "PR" 'pour préscolaire
Range("F" & Target.Row).Value = "Préscolaire"
Case "SP", "SM", "SG", "ST"
'ST pour STP, cela marche pour SP/SM bien sûr
Range("F" & Target.Row).Value = "Mat"
'le résultat est sur la même ligne que la saisie, mais en colonne F
Case "CP", "CE", "CM", "AD", "PE", "CJ"
'AD pour adapt, PE pour perf, CJ pour CJA
Range("F" & Target.Row).Value = "Prim"
Case "6", "5", "4", "3", "6°", "5°", "4°", "3°", "CA"
'CA pour CAP
Range("F" & Target.Row).Value = "Collège"
Case "3", "2", "1", "TE", "3°", "2°", "1°", "BE", "BP"
'BE pour BEP, BT pour BTS
'pour prendre en compte un 2è caractère si c'est ° après un chiffre au collège et lycée
Range("F" & Target.Row).Value = "Lycée"
Case "UN" 'pour université
Range("F" & Target.Row).Value = "Université"
Case "HA" 'pour handicapé
Range("F" & Target.Row).Value = "Handicapé"

End Select
Application.EnableEvents = True
End Sub

 

[Raimana]

Re : Recherche macro ou fonction

Juste pour vous prévenir que j'ai changé la colonne d'origine "G" au kieu de "E" d'où l'apparition du 8 dans la macro à la place du 5 !

A+
Raimana