Comparer des valeurs et renvoyer une fleche...

C

chrisclaret

XLDnaute Occasionnel
Bonjour,

J'ai realise un bulletin d'evaluation par competence pour le college.
Je bloque sur la fin...
En effet , je souhaiterais comparer les points de couleurs de T1 et T2 et suivant l'evolution afficher ds la colonne Q le resultat par une fleche.
Dans les colonnes T1,T2,T3 je fais la moyenne des compétences de la ligne consideree.
Je deplace la formule moy d'un trimestre à l'autre et je fais un copier coller valeur pour conserver la colonne de gauche et ainsi comparer les trimestres consécutifs.
J'ai une formule en Q que j'utilisais ailleurs et qui compare les valeurs en T1 et T2 mais comme un point de couleur correspond à un intervalle de reussite cela pause probleme.
Ex;
0<moy<25% alors rouge
25<moy<50% alors orange
50<moy<75% alors bleu
75<moy<100% alors vert.

Si l'eleve a eu orange et orange en T1 et T2 il me faudrait une fleche horizontale or comme chaque orange correspond a une valeur souvent differente compris dans un intervalle il compare les valeurs et me met une fleche verte.(Ex en Q13).
Il faudrait que suivant l'intervalle ds laquelle se situe la moy im me renvoie dans T1,T2... la valeur 0.25 ou 0.5 ou 0.75 pour pouvoir ensuite etre comparé mais je n'y arrive pas , à moins qu'une autre idee existe...
Voilà...
Chris
 

Pièces jointes

  • bulletin par competence A3 download.xlsx
    22.7 KB · Affichages: 263
Trier par date Trier par votes
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Re,

Voici un bout de ta macro modifiée :

VB: 
        If IsError(Application.Match([S3], WsD.[A1:W1], 0)) Then 'Si le libellé est faux dans la feuille élève => message et pas de traitement
          MsgBox "Pas de libellé """ & [S3] & """ pour " & Nom
        Else 'Sinon, traitement
          Dest = Application.Match([S3], WsD.[A1:W1], 0)
          y = 1
          For i = 1 To UBound(Col)
            For j = 1 To Col(i)
              c = Dest + j - 1
              WsD.Cells(i + 1, c) = Cells(x, y + j)
              'S'il y a un commentaire dans la colonne y+j de la ligne 5, alors ...
              If Not (Cells(5, y + j).Comment Is Nothing) Then
                'Suppression d'un commentaire éventuel dans la cellule de destination
                WsD.Cells(i + 1, c).ClearComments
                'Ajout d'un commentaire
                WsD.Cells(i + 1, c).AddComment
                'Copie le commentaire de la cellule de la feuille Evaluation dans la cellule destinataire
                WsD.Cells(i + 1, c).Comment.Text Cells(5, y + j).Comment.Text
              End If
            Next
            y = y + Col(i)
          Next
        End If
      End If

A+

Martial
 
Vote positif 0 Vote négatif
C

chrisclaret

XLDnaute Occasionnel
Re : Comparer des valeurs et renvoyer une fleche...

Bonjour Yaloo,le forum,

Ben j'ai fait la modif et pas de commentaire qui apparait...:confused:

Sub Test1() 'Voir module ModTest
Dim x As Variant
Dim y As Variant
Dim i As Integer
Dim j As Integer
Dim Dest
Verif = False
Application.Calculation = xlManual
For Each x In Sheets("Evaluation").Range("A8:A" & Sheets("Evaluation").Range("A43").End(xlUp).Row) 'Boucle sur la premiere colonne du fichier évaluation
i = 0
j = 0
If x.Value <> 0 And x.Value <> "" Then 'S'il y a un nom dans la cellule
For Each z In ThisWorkbook.Sheets 'Vérifie si l'onglet destination existe
If z.Name = x.Value Then Verif = True
Next
If IsError(Application.Match([S3], WsD.[A1:W1], 0)) Then 'Si le libellé est faux dans la feuille élève => message et pas de traitement
MsgBox "Pas de libellé """ & [S3] & """ pour " & Nom
Else 'Sinon, traitement
Dest = Application.Match([S3], WsD.[A1:W1], 0)
y = 1
For i = 1 To UBound(Col)
For j = 1 To Col(i)
c = Dest + j - 1
WsD.Cells(i + 1, c) = Cells(x, y + j)
'S'il y a un commentaire dans la colonne y+j de la ligne 5, alors ...
If Not (Cells(5, y + j).Comment Is Nothing) Then
'Suppression d'un commentaire éventuel dans la cellule de destination
WsD.Cells(i + 1, c).ClearComments
'Ajout d'un commentaire
WsD.Cells(i + 1, c).AddComment
'Copie le commentaire de la cellule de la feuille Evaluation dans la cellule destinataire
WsD.Cells(i + 1, c).Comment.Text Cells(5, y + j).Comment.Text
End If
Next
y = y + Col(i)
Next
End If
End If
Else
MsgBox "L'onglet destination n'existe pas pour : " & x.Value
End If
End If
Verif = False
Next
Application.Calculation = xlCalculationAutomatic
End Sub

A+
Chris
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Bonjour Chris,

J'ai modifié un peu la macro pour ne copier le commentaire que lorsque la cellule est remplie, mais chez moi la macro fonctionnait normalement.

J'ai rajouté une macro dans le module ModSupComment afin de supprimer les commentaires des feuilles élèves.

VB: 
        Else 'Sinon, traitement
          Dest = Application.Match([S3], WsD.[A1:W1], 0)
          y = 1
          For i = 1 To UBound(Col)
            For j = 1 To Col(i)
              c = Dest + j - 1
              If Cells(x, y + j) <> "" Then
                WsD.Cells(i + 1, c) = Cells(x, y + j)
                'S'il y a un commentaire dans la colonne y+j de la ligne 5, alors ...
                If Not (Cells(5, y + j).Comment Is Nothing) Then
                  'Suppression d'un commentaire éventuel dans la cellule de destination
                  WsD.Cells(i + 1, c).ClearComments
                  'Ajout d'un commentaire
                  WsD.Cells(i + 1, c).AddComment
                  'Copie le commentaire de la cellule de la feuille Evaluation dans la cellule destinataire
                  WsD.Cells(i + 1, c).Comment.Text Cells(5, y + j).Comment.Text
                End If
              End If
            Next
            y = y + Col(i)
          Next
        End If

Je t'ai mis le fichier sur ton mail.

A+

Martial
 
Vote positif 0 Vote négatif
C

chrisclaret

XLDnaute Occasionnel
Re : Comparer des valeurs et renvoyer une fleche...

Re ,
Toujours aussi efficace je vois....;)Tu devrais bosser pour microsoft!
J'ai pu le tester de 11h30 à 12h30.
Fonctionne parfaitement et bonne idée pour le dernier module.
Il y aurait une petite modif à apporter :
La police n'est pas respectée lorsque les commentaires passent de la page "Evaluation" à la page "Eleve" ce qui fait que c'est difficilement visible pour ceux au fond de la classe.

Dans la suite logique...
1/Est-ce possible de conserver ce systeme lorsque j'enregistre les evaluations(enregistrements avec commentaires et uniquement sur les cellules utilisées) ?(Macro Enregistrer)
2/Serait-ce possible via un 4 eme bouton sur le userform 5 de faire apparaitre les commentaire de la feuille "Evaluation" lorque je les survolent(ou autre systeme equivalent) ?
(En tp les eleves ne savent pas sur quoi ils vont etre evalué et donc lorsque je fais le bilan via le userform 5 à la fin de la seance , je pourrais leur montrer la question qui se rapportait au bouton lorsque je survole les resultats de l'eleve...)
A+:eek:
Chris
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Re,

Pour la première partie, comme ça :
VB: 
          For i = 1 To UBound(Col)
            For j = 1 To Col(i)
              c = Dest + j - 1
              If Cells(x, y + j) <> "" Then
                WsD.Cells(i + 1, c) = Cells(x, y + j)
                'S'il y a un commentaire dans la colonne y+j de la ligne 5, alors ...
                If Not (Cells(5, y + j).Comment Is Nothing) Then
                  'Suppression d'un commentaire éventuel dans la cellule de destination
                  WsD.Cells(i + 1, c).ClearComments
                  'Ajout d'un commentaire
                  WsD.Cells(i + 1, c).AddComment
                  'Copie le commentaire de la cellule de la feuille Evaluation dans la cellule destinataire
                  WsD.Cells(i + 1, c).Comment.Text Trim(Cells(5, y + j).Comment.Text)
                  WsD.Cells(i + 1, c).Comment.Shape.DrawingObject.Font.Size = 11
                  WsD.Cells(i + 1, c).Comment.Shape.DrawingObject.Font.Bold = True
                  WsD.Cells(i + 1, c).Comment.Shape.DrawingObject.AutoSize = True
                End If
              End If
            Next
            y = y + Col(i)
          Next

A+
 
Vote positif 0 Vote négatif
C

chrisclaret

XLDnaute Occasionnel
Re : Comparer des valeurs et renvoyer une fleche...

Re,
Pour le 1/ , celà revient à faire le meme travail qu'avec la macro "Transfert des competences vers les feuilles eleves" mais cette fois-ci sur la macro "Enregistrer".
Ainsi j'aurai les commentaires associés ds mon fichier Evaluation3F1trimestre2 en survolant chaque point.
A+
Chris
 
Vote positif 0 Vote négatif
C

chrisclaret

XLDnaute Occasionnel
Re : Comparer des valeurs et renvoyer une fleche...

Bonjour Yaloo, le fil ,

Impressionnant le travail !:)

Juste une petite chose , j'ai transposé les nveaux modules sur un fichier classe de cet apres-midi et lorsqu'il y a trop de compétences il m'affiche ce message ds le module de classe CB5 :

If Not (Feuil3.Range(.Tag).Comment Is Nothing) Then (bug içi)

apres m'avoir mis au prealable :
Erreur d'execution 1004
La méthode Range de l'objet Worksheet a échoué..
Je t'envoie le fichier sur ton mail..
MERCI,
A+
Chris
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Bonsoir Chris, le forum,

Pour récupérer l'adresse de la cellule contenant le commentaire, je me sers des Tag(s) des boutons.
Mais comme il y a déjà des Tag(s) dans les boutons, je les avais mis au début, mais ne m'en sers plus, et si tu n'as pas de commentaire dans ta cellule, le Tag n'est pas modifié.
Par exemple, en cellule $T$5 pour l'évaluation C1 tu n'as pas de commentaire, donc le Tag restait avec la valeur initiale (qui est un chiffre) et non l'adresse de la cellule contenant le commentaire, d'où le plantage.

En début d'initialisation de l'UserForm5, il faut mettre ça :
VB: 
Private Sub UserForm_Initialize()
Dim Groupes
j = 1
For i = 1 To 6
  For k = 1 To 4
    For c = 1 To 12
      NumCB = i * 1000 + k * 100 + c
  Set CB(j).CB = Controls("CB" & NumCB): Controls("CB" & NumCB).Tag = "": j = j + 1
Next: Next: Next
Cela permet de supprimer les Tag(s) de chaque bouton, les bons Tag seront mis plus tard dans la macro.

A+

Martial
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Re,

J'ai repris ta demande concernant l'enregistrement de la feuille Evaluation.
Avec ta macro, tu copies complètement ta feuille Evaluation dans le classeur, donc tes commentaires sont également copiés en ligne 5. Je ne vois pas trop l'intérêt de copier le commentaire sur chaque point car la question est toujours la même.

A moins que je ne me trompe ;)

A+

PS : bon techniquement c'est faisable donc si tu y tiens, ça peut se faire.
 
Vote positif 0 Vote négatif
C

chrisclaret

XLDnaute Occasionnel
Re : Comparer des valeurs et renvoyer une fleche...

Bonjour Yaloo , le forum ,

Pour repondre à ton post precedent , le tableau de la page Evaluation n'apparait pas completement sur l'ecran ce qui m'oblige pour la fin de liste à remonter le curseur droite pour montrer les competences à chaque nouveau parent...
Voilà , c'etait juste du confort , à toi de voir si celà n'est pas trop long alors pourquoi pas, sinon on laisse tomber.

Pour la derniere version du userform5 , c'est génial mise à part une tte petite chose .
Lorsque je suis un peu trop loquace ds mes commentaires , ils sont coupés car tu as un cadre fixe.
N'y-a-t-il pas moyen que celui-ci s'adapte au contenu comme lorsque je transfert les competences vers les feuilles eleves ?
Si trop compliqué ou si ça risque de ralentir l'apparition du userform 5 , dans ce cas , juste l'agrandir un peu...;)

Cette nouvelle version du userform5 a rajouté environ 5 s à l'apparition du celui-ci pour un delai maintenant de 15 s environ.
En revanche , l'apparition du podium groupe a été considerablement augmenté(1 min) au lieu d'une dizaine de sec.
N'y-a-t-il pas moyen d'accelerer ce processus ...
Je te mets la derniere version en PJ ds ton mail.
A+:eek:
Chris
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Comparer des valeurs et renvoyer une fleche...

Bonjour Chris, le fil,

chrisclaret à dit:
Pour repondre à ton post precedent , le tableau de la page Evaluation n'apparait pas completement sur l'ecran ce qui m'oblige pour la fin de liste à remonter le curseur droite pour montrer les competences à chaque nouveau parent...
Voilà , c'etait juste du confort , à toi de voir si celà n'est pas trop long alors pourquoi pas, sinon on laisse tomber.
Cliquez pour agrandir...

Pourquoi ne pas mettre des volets horizontaux et verticaux puis les figer, comme ça tu as tous tes élèves et toutes tes questions. Cela peut se faire par macro, dis-moi si OK.

chrisclaret à dit:
Pour la derniere version du userform5 , c'est génial mise à part une tte petite chose .
Lorsque je suis un peu trop loquace ds mes commentaires , ils sont coupés car tu as un cadre fixe.
N'y-a-t-il pas moyen que celui-ci s'adapte au contenu comme lorsque je transfert les competences vers les feuilles eleves ?
Si trop compliqué ou si ça risque de ralentir l'apparition du userform 5 , dans ce cas , juste l'agrandir un peu...;)
Cliquez pour agrandir...

J'avais essayé de les mettre en AutoSize mais cela mettait une forme plutôt verticale et non horizontale, on peut peut-être mettre 2 ou 3 formats en fonction du nombre de caractères dans ton commentaire. Dis-moi si OK.

chrisclaret à dit:
Cette nouvelle version du userform5 a rajouté environ 5 s à l'apparition du celui-ci pour un delai maintenant de 15 s environ.
En revanche , l'apparition du podium groupe a été considerablement augmenté(1 min) au lieu d'une dizaine de sec.
N'y-a-t-il pas moyen d'accelerer ce processus ...
Cliquez pour agrandir...

A force d'ajouter et d'ajouter des choses, ça alourdi l'ensemble, mais d'une dizaine de secondes à 1 minute, cela parait beaucoup, sachant que je n'ai pas touché aux podiums.

A te relire

Martial
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
Microsoft 365 VBA EXCEL pour rechercher une valeur et copier des valeurs à la suite
Réponses
2
Affichages
364
justine.valck
J
Y
  • Question
XL 2019 Macro pour supprimer des lignes et modifier des valeurs selon une correspondance
Réponses
6
Affichages
471
Yoshi0302
Y
B
  • Résolu(e)
XL 2010 Macro qui compare les valeurs d’un tableau en date t et en date t-1
Réponses
12
Affichages
592
Dudu2
Dudu2
J
  • Résolu(e)
XL 2016 vba cherche 2 valeurs dans une autre feuille et remplace des données
Réponses
9
Affichages
1 K
julien741
J
Y
  • Résolu(e)
XL 2016 Extraire une ligne des valeurs depuis basse des données vers une autre feuille de travail selon critère
Réponses
2
Affichages
963
YANNISE
Y
W
  • Question
XL 2010 recherche d'une valeur en fonction de colonnes dont les intitulés sont des plages de valeurs
Réponses
4
Affichages
1 K
WalloWG
W
D
  • Question
XL 2019 boucle qui compte les valeurs des cellules
Réponses
4
Affichages
643
desmonts
D
C
  • Question
comparer un chiffre dans un tableau et récuperer une information associée
Réponses
4
Affichages
542
citroends12
C
M
  • Question
XL 2019 Comparer 2 cellules et renvoyer une valeur
Réponses
2
Affichages
784
Mel62
M
E
  • Résolu(e)
Microsoft 365 Transférer valeurs de Textbox et ComboBox dans classeur
Réponses
8
Affichages
1 K
Emli15
E

Membres actuellement en ligne

15 membres et 61 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 347
Messages
2 087 504
Membres
103 565
dernier inscrit
Fabien78