Couleur cellule selon un critère d'une liste déroulante
Résolu- Couleur cellule selon un critère d'une liste déroulante
- Liste déroulante excel - Guide
- Liste déroulante en cascade - Guide
- Excel cellule couleur si condition texte - Guide
- Aller à la ligne dans une cellule excel - Guide
- Somme si couleur - Guide
3 réponses
8 mars 2024 à 15:35
bonjour,
pour étendre aux 4 cellules en dessous, je ferais ainsi (pas testé, car tu n'as pas donné de fichier de test):
Option Explicit
Sub ColorCellules()
Dim F1 As Worksheet, Z As Integer, cell As Range, plage As Range
Application.ScreenUpdating = False
Set F1 = ActiveSheet
Set plage = F1.Range("D34:M34")
For Each cell In plage
For Z = 39 To 46 Step 1
If cell.Value = Cells(Z, 2).Value Then
cell.Resize(5).Interior.Color = F1.Cells(Z, 2).Interior.Color
cell.Resize(5).Font.Color = F1.Cells(Z, 2).Font.Color
Exit For
End If
Next Z
Next cell
Application.ScreenUpdating = True
End Sub
J'ai fait les changements, mais j'ai peut-être oublié quelque chose, car à la ligne If cell.Count il m'indique un bug cell est sélectionné (Erreur de compilation : Variable non définie).
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim F1 As Worksheet, Z As Integer
Application.ScreenUpdating = False
Set F1 = ActiveSheet
If cell.Count = 1 And Not Intersect(cell, F1.Range("D34:M34")) Is Nothing Then
For Z = 39 To 46 Step 1
If cell.Value = Cells(Z, 2).Value Then
Application.EnableEvents = False
cell.Resize(5).Interior.Color = F1.Cells(Z, 2).Interior.Color
cell.Resize(5).Font.Color = F1.Cells(Z, 2).Font.Color
Application.EnableEvents = True
Exit For
End If
Next Z
End If
Application.ScreenUpdating = True
End Sub
14 mars 2024 à 14:39
Worksheet_SelectionChange devait être remplacé par Worksheet_Change, il ne faut pas toucher au reste de la ligne, il faut simplement supprimer "Selection".
Modifié le 20 mars 2024 à 14:39
Tout fonctionne à merveille, merci!
J'aimerais ajouter deux petits trucs :
Si ce critère est sélectionné : "-" que seulement cette cellule qui soit coloré et d'étendre la couleur blanc de 5.
Un message box pour afficher qu'il n'accepte pas de cellule vide, qu'il doit obligatoirement avoir un critère de sélectionné.
J'en demande beaucoup alors merci encore!! :D
20 mars 2024 à 14:38
Si on n'étend pas la couleur, on y laisse alors la couleur précédente?
Toujours non testé:
Option Explicit
Private Sub Worksheet_Change(ByVal cell As Range)
Dim F1 As Worksheet, Z As Integer, r As Integer
Set F1 = ActiveSheet
If cell.Count = 1 And Not Intersect(cell, F1.Range("D34:M34")) Is Nothing Then
If cell = "" Then
MsgBox "oups"
Else
For Z = 39 To 46 Step 1
If cell.Value = Cells(Z, 2).Value Then
If cell = "-" Then
r = 1
Else
r = 5
End If
Application.EnableEvents = False
cell.Resize(r).Interior.Color = F1.Cells(Z, 2).Interior.Color
cell.Resize(r).Font.Color = F1.Cells(Z, 2).Font.Color
Application.EnableEvents = True
Exit For
End If
Next Z
End If
End If
End Sub
Modifié le 21 mars 2024 à 20:44
Super! Merci beaucoup de ton aide très précieuse!
8 mars 2024 à 15:44
Pour exécuter cela automatiquement dès la sélection du critère, je mettrais ceci dans le module de la feuille:
Option Explicit Private Sub Worksheet_SelectionChange(ByVal cell As Range) Dim F1 As Worksheet, Z As Integer Application.ScreenUpdating = False Set F1 = ActiveSheet If cell.Count = 1 And Not Intersect(cell, F1.Range("D34:M34")) Is Nothing Then For Z = 39 To 46 Step 1 If cell.Value = Cells(Z, 2).Value Then Application.EnableEvents = False cell.Resize(5).Interior.Color = F1.Cells(Z, 2).Interior.Color cell.Resize(5).Font.Color = F1.Cells(Z, 2).Font.Color Application.EnableEvents = True Exit For End If Next Z End If Application.ScreenUpdating = True End SubModifié le 11 mars 2024 à 14:28
Super le code pour étendre la couleur fonctionne!! Merci :)
Le code pour l'exécution automatique fonctionne, mais seulement si je reclique ensuite sur la case où se trouve le critère, il ne s'exécute pas dès la sélection. C'est quand même génial d'en être arrivé là !
12 mars 2024 à 08:02
Oups, je me suis trompé, Worksheet_SelectionChange doit être remplacé par Worksheet_Change.
12 mars 2024 à 08:07
Techniquement, il suffisait d'ajouter .Resize(5) pour étendre la couleur.
Je n'ai pas résisté et j'ai corrigé quelques maladresses dans le code.