RechercheV avec variable pour interior.colorindex

Résolu/Fermé

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022 - 19 oct. 2021 à 12:17
yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 - 29 oct. 2021 à 14:28

Bonjour,

Je cherche le moyen de colorer les cellules en fonction de la valeur tapée.
J'ai un tableau avec des codes qui ont chacun une couleur de remplissage en 1ère colonne et avec la fonction que j'ai créé en vba, je récupère la colorindex dans la 2ème colonne.

Fct numcolor :

Function NumColor(Cellule As Range) As Integer
Application.Volatile
NumColor = Cellule.Interior.ColorIndex
End Function

Dans une autre feuille, je voudrais qu'en tapant un des codes, la cellule se colore automatiquement au bon colorIndex.

J'arrive a colorer la plage des codes que j'aurais encodé dans la feuille2 via une rechercheV dans une autre zone de la feuille et ensuite récupérer la valeur de cette rechercheV pour colorer la cellule avec son résultat.

Sub Color()

Dim LR As Integer
Dim IC As Variant
Dim i As Integer

    Range("B3").Select
    Selection.End(xlDown).Select
    LR = Selection.Row

    For i = 3 To LR
    
    Range("B" & i).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],TcolorZone,2,FALSE)"
    IC = Selection.Value
    Selection.Offset(0, -1).Select
    Selection.Interior.ColorIndex = IC
    
    Next
    
End Sub

Comment faire par exemple pour que sur remplissage de la cellule, automatiquement, une rechercheV s'enclenche, que son résultat devienne la colorIndex de remplissage de la cellule qui vient d'être remplie?

D'avance merci.

Boris

Configuration: Windows / Chrome 94.0.4606.81

A voir également:

RechercheV avec variable pour interior.colorindex
2 recherchev dans une formule - Forum Excel
Variable objet ou variable de bloc with non définie - Forum VB / VBA
Recherchev ou ✓ - Forum Bureautique
Recherchev si contient - Forum Excel
Impossible de créer le fichier de travail. vérifiez la variable d'environnement temp ✓ - Forum Word

8 réponses

Réponse 1 / 8

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
19 oct. 2021 à 12:52

bonjour,
ta description est un peu floue.
tu mélanges la description de ce que tu veux obtenir avec la description de ce que tu as réalisé.
Au lieu d'utiliser "une autre feuille", "la feuille2", "la feuille", ce serait plus clair su tu utilisais des noms pour chaque feuille.

si je devine ce que tu veux faire, tu dois créer une fonction worksheet_change.

dans cette fonction, pour chaque cellule modifiée, rechercher la couleur correspondant à la nouvelle valeur, et appliquer cette couleur.

Réponse 2 / 8

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
19 oct. 2021 à 13:03

il est important d'éviter d'utiliser select et active dans le code.
au lieu de

Range("B3").Select
    Selection.End(xlDown).Select
    LR = Selection.Row

tu peux faire

    LR = Range("B3").End(xlDown).Row

de même, au lieu de

Range("B" & i).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],TcolorZone,2,FALSE)"
    IC = Selection.Value
    Selection.Offset(0, -1).Select
    Selection.Interior.ColorIndex = IC

tu peux écrire

    Range("B" & i).FormulaR1C1 = "=VLOOKUP(RC[-1],TcolorZone,2,FALSE)"
    IC = Range("B" & i).Value
    Range("B" & i).Offset(0, -1).Interior.ColorIndex = IC

Réponse 3 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
20 oct. 2021 à 10:49

Bonjour,

Merci pour ta réponses et tes conseils. Je ne sais pas si c'est le plus rapide pour Excel mais cela marche. Dans la plage de cellules où j'encode les codes, les cellules se colorent en allant chercher via une rechercheV la valeur du colorindex du code en question.

J'ai donc la macro avec le code suivant :

Sub Color2()

Dim LR As Integer
Dim IC As Variant
Dim c As Range
    
    LR = Range("A4").End(xlDown).Row
    
    Set zonecode = Range("B4:AF" & LR)
    
    For Each c In zonecode
    
    If c.Value = "" Then GoTo Skip_c
    
    c.Offset(0, 38).FormulaR1C1 = "=VLOOKUP(RC[-38],TcolorZone,2,FALSE)"
    IC = c.Offset(0, 38).Value
    c.Interior.ColorIndex = IC
   
Skip_c:
    
    Next c

End Sub

Et dans la feuille où les codes seront encodés, un worksheet_Change :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

If Not Intersect(Target, Range("A4:AF38")) Is Nothing Then

Call Color2

    If Target.Count = 1 Then If ActiveCell.Address <> Target.Address Then Target.Select

    End If
  
End Sub

Maintenant je suis quand même bloqué.
En fait il s'agit d'un fichier de gestion des présences des employés. Les codes sont à mettre chaque jour dans une feuille mois (ex 800 présent, 200 malade, 300 congé, etc).
Pour créer le fichier pour toute l'année, j'ai fait une macro qui génère les 12 feuilles (1 par mois). Maintenant, il faudrait que j'arrive dans cette macro à faire écrire à VBE la procédure Worksheet_Change dans chaque page générée.

As-tu une idée?

D'avance merci

Boris

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
20 oct. 2021 à 15:49

Je pense que le plus propre, alors, est d'utiliser Workbook SheetChange.

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
20 oct. 2021 à 15:58

par ailleurs, je suis consterné par ton code.
je ferais plutôt (non testé):

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A4:AF38")) Is Nothing Then
   Call Color2(Intersect(Target, Range("A4:AF38")))
End If
End Sub

Sub Color2(zonecode)
Dim c As Range
For Each c In zonecode
    If c.Value <> "" Then 
         c.Offset(0, 38).FormulaR1C1 = "=VLOOKUP(RC[-38],TcolorZone,2,FALSE)"
         c.Interior.ColorIndex = c.Offset(0, 38).Value
    end if
Next c
End Sub

Réponse 4 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
21 oct. 2021 à 14:16

consterné par mon code :):) à ma décharge je suis un pur autodidacte et ce que depuis qq mois et je ne suis pas du métier. Merci pour tes conseils de pureté de code.

OK pour workbook sheetChange mais comment faire pour que cela ne concerne pas toutes les feuilles du classeur mais que celles qui seraient nommées de 1 à 12 (ce sont les feuilles qui représentent les 12 mois)?

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
21 oct. 2021 à 20:58

il ne s'agit pas uniquement de pureté, ton code réappliquait les couleurs de toutes les cellules chaque fois qu'une était modifiée.

as-tu étudié les paramètres de workbook sheetChange?

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
22 oct. 2021 à 14:55

Oui j'ai regardé, mais j'ai d'autre feuilles dans le classeur sur lesquels je ne veux pas de procédure de ce type, de la ma question si je pouvais lla circonscrire à certaines des feuilles et pas toutes.

J'ai réussi avec Private Sub Worksheet_Change (dans la macro de création des 12 feuilles mois, j'ai ajouté une procédure pour que la Private Sub soit écrite dans chacune des 12 feuilles).

Par contre, si l'utilisateur encode une valeur qui n'est pas dans la liste sur laquelle la VLookUp se base, forcément ça bug. J'essaye de stopper la boucle for each avec On Error Goto et une msgbox d'avertissement suivie d'un resume ou d'un exit mais ça ne marche pas. Je dois le positionner où le On Error Goto dans la macro ou dans la Private Sub?

Idéalement, je voudrais que le message d'erreur apparaisse puis forcer le repositionnement sur la cellule où le code erroné à été entré (voir avec une inputbox) mais quand j'essaye, Excel se positionne sur la cellule en-dessous et donc réenvoie la msgbox.

D'avance merci

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
22 oct. 2021 à 16:53

Le plus simple n'est-il pas d'utiliser workbook sheetChange et d'y vérifier le nom de la feuille?

"forcément ça bug": tu ne montres ni ce que tu as essayé, ni le résultat obtenu.

Réponse 6 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
25 oct. 2021 à 14:58

Bonjour,

J'ai utilisé les codes que tu m'as envoyé (le 20 octobre), ça marche.
J'ai utilisé la procédure suivante lors de la création des pages mensuelles (et donc repris ton code) et ce pour les 12 pages mensuelles créées.

With ActiveWorkbook.VBProject.VBComponents(Worksheets("Jan").CodeName).CodeModule
        ligne = .CountOfLines
        .InsertLines ligne + 1, "Private Sub Worksheet_Change(ByVal Target As Range)"
        .InsertLines ligne + 2, "If Not Intersect(Target, Range(""A4:AF300"")) Is Nothing Then"
        .InsertLines ligne + 3, "Call Color2(Intersect(Target, Range("A4:AF300")))
        .InsertLines ligne + 4, "End If"
        .InsertLines ligne + 5, "End Sub"
    End With

NB j'ai mis 300 en row sachant que cela n'irait pas au-dessus (mais surtout pour éviter une variable de End(xlDown).row

Maintenant les codes numérique appartiennent à une liste de code qui ont chacun une couleur que j'ai nommée CodeLegende (et qui est dynamique)

Donc la macro Color2 a bien le code suivant :

Sub Color2(zonecode)

Dim c As Range
Dim LR As Integer

    LR = Range("A4").End(xlDown).Row
Set zonecode = Range("B4:AF" & LR)

For Each c In zonecode
    If c.Value <> "" Then
         c.Offset(0, 51).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-51],CodeLegende,3,FALSE),"""")"
         c.Interior.ColorIndex = c.Offset(0, 51).Value
    End If
Next c
End Sub

J'ai tenté ceci pour la gestion d'erreur mais cela ne marche pas, de 1 lorsque je mets un code valide dans l'inputbox, il s'inscrit bien dans la bonne cellule mais ne se colore pas dans la couleur attaché à ce code, mais surtout, du coup, il enchaîne à chaque fois vers la cellule du haut en relançant la gestion de l'erreur et donc l'inputbox.

Sub Color2(zonecode)

Dim c As Range
Dim LR As Integer

    LR = Range("A4").End(xlDown).Row
Set zonecode = Range("B4:AF" & LR)

On Error GoTo Erreur:

For Each c In zonecode
    If c.Value <> "" Then
         c.Offset(0, 51).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-51],CodeLegende,3,FALSE),"""")"
         c.Interior.ColorIndex = c.Offset(0, 51).Value
    End If
Next c

Erreur:
    'MsgBox "Code non valide !", vbExclamation, "Code Erreur"
    Y = InputBox("Entrez code valide", "Code n'existe pas")
    Selection.Offset(-1, 0).Select
    Selection.Value = Y
    Resume
   

End Sub

Donc si tu pouvais m'aider pour cette gestion d'erreur, ce serait top.

Quant à ta question : "Le plus simple n'est-il pas d'utiliser workbook sheetChange et d'y vérifier le nom de la feuille?", probablement mais comment vérifie-t-on le nom de la feuille?

D'avance merci

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 oct. 2021 à 15:01

Ne peux-tu pas utiliser la propriété

Name

de la feuille reçue en paramètre de Workbook.SheetChange?

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 oct. 2021 à 15:14

J'ai l'impression que tu n'as pas utilisé ma suggestion en #5.

Tu indiques vouloir traiter une erreur, sans expliquer de quelle erreur il s'agit.

peux-tu préciser le langage ("basic") quand tu utilises les balises de code?

peut-être veux-tu faire

Resume Next

au lieu de

Resume

?

ne devrais-tu pas tester le contenu retourné par la formule avant d'appliquer la couleur?

Réponse 7 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
25 oct. 2021 à 15:05

NB. Dans la ligne3 des codes inscrit dans chaque feuille,

 .InsertLines ligne + 3, "Call Color2(Intersect(Target, Range(""A4:AF300"")))

la range est bien entre '4' guillemets.

Réponse 8 / 8

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
25 oct. 2021 à 16:45

Non je n'ai pas utilisé "workbook sheetChange et d'y vérifier le nom de la feuille" parce que justement je ne sais pas comment faire...

L'erreur que je veux traiter est quand on tape un code qui n'existe pas dans ma plage nommée CodeLegende, je veux avertir l'utilisateur que ce code n'existe pas et soit le remettre sur la cellule en question qui serait vidée soit via une inputbox afin qu'il ré encode un code valide.

ne devrais-tu pas tester le contenu retourné par la formule avant d'appliquer la couleur?
Et comment je ferais cela?
Avec Match? Avec un countif =0?

Je n'y arriverai pas seul, montre moi stp.

Merci

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 oct. 2021 à 16:56

si tu ne traites pas l'erreur, que se passe-t-il?

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 oct. 2021 à 17:02

J'ai l'impression que tu n'as pas utilisé ma suggestion en #5.

BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022 > yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024
26 oct. 2021 à 10:26

Si j'entre un code qui n'existe pas : Erreur d'exécution '13' incompatibilité de type dans la Sub Color2(zonecode)

For Each c In zonecode
    If c.Value <> "" Then
         c.Offset(0, 51).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-51],CodeLegende,3,FALSE),"""")"
        <gras> c.Interior.ColorIndex = c.Offset(0, 51).Value</gras>
    End If
Next c

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > BoJav Messages postés 49 Date d'inscription mardi 23 février 2021 Statut Membre Dernière intervention 17 février 2022
26 oct. 2021 à 10:45

c'est la ligne 4, en gras, qui est surlignée quand l'erreur se produit?
si oui, tester le contenu retourné par la formule avant d'appliquer la couleur:

Sub Color2(zonecode)
Dim c As Range
For Each c In zonecode
    If c.Value <> "" Then 
         c.Offset(0, 38).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-51],CodeLegende,3,FALSE),"""")"
         if c.Offset(0, 38).Value <> "" then
             c.Interior.ColorIndex = c.Offset(0, 38).Value
         else
             MsgBox "Code non valide !", vbExclamation, "Code Erreur"
         end if
    end if
Next c
End Sub

Tu parles de ça :"utiliser workbook sheetChange et d'y vérifier le nom de la feuille"

Comment je fais pour vérifier le nom de la feuille??? J'ai compris que l'idée est d'utiliser wrkbook sheetchange pour les feuilles jan fev...dec plutôt que de faire une private sub dans chaque feuille mais concrètement comment fait-on? J'ai cherché j'y arrive pas. Je te rappelle que suis néophyte en matière de VBA.

D'avance merci

Discussions similaires

programme qui n'affiche pas le mot secret

VBA : Range avec références variables..

[Excel] Recherche de Texte avec RechercheV

Combiné SI et RECHERCHEV excel

RECHERCHEV additionne les plusieurs lignes du meme nom

Discussions similaires

Newsletters