Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Mise ne forme conditionnellr par vba

Mise ne forme conditionnellr par vba

13 réponses
Avatar
Jacquouille Le Gaulois
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Jacquouille Le Gaulois
Bonjour,

Une petite question de débutant dans ce code

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(16, 17, 18, 19, 20, 2, 22, 23, 24, 2, 26, 27, 28, 29,
30, 31, 32, 33, 34, 2, 36, 39, 40, 41, 42, 43, 44, 45, 46, 47, 37, 37,
37, 37)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

seul les couleurs jusqu a 28 fonctionnent, y a t il un nombre limite de
valeur à mettre a la fonction array :-Z




Re,

Ce n'est pas vraiment qu'il ne fonctionne pas ;-))

Simplement la comparaison se fait avec les cellules de la ligne 4 de la
feuille active. Pour comparer avec les données de la feuille "Code",

remplace simplement la ligne

If c = Range("B4").Offset(0, i) Then

par

If c = Sheets("Code").Range("B4").Offset(0,
i) Then

et code cette version modifiée dans le module de chacune des feuilles
mensuelles.

ou mieux,

copie ceci dans le module de chaque feuille mensuelle :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, i As Integer
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
Compare c
Next c
End If
End Sub

et cela dans un module standard :

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

L'intérêt est que si tu veux modifier les codes couleurs, tu n'auras à
le faire qu'une fois.



Bonjour Michel Gaboly,

En effet je suis debutant et j essaye de me prefectionner par le biaie
de ce forum.
J ai essaye ton code avec array :'( il ne fonctionne pas, en effet jai
un classeur avec une feuille par mois et une feuille qui me sert de
code.
Ce que je veux c est que si je mets en "B4" sur ma feuille "Code" la
lettre "G" par exemple et qu ensuite je saisi dans une de mes feuilles
mois dans une des cellules de la plages "C6:AG35" le valeurs "G" alors
la cellule se coloris d'une certaine couleur

merci

Michel Gaboly a exprimé avec précision :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



Avatar
Eric KERGRESSE
Bonjour,

Il faut que la boucle For puisse lire toute les données de ton tableau Mat,
pour cela, il faut modifier la ligne

For i = 0 To 12

et remplacer 12 par le nombre de valeurs de tableau et retrancher 1

dans ton cas 34 valeurs donc For I= 0 to 33

Cordialement

"Jacquouille Le Gaulois" a écrit dans le message
de news:
Bonjour,

Une petite question de débutant dans ce code

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(16, 17, 18, 19, 20, 2, 22, 23, 24, 2, 26, 27, 28, 29,
30, 31, 32, 33, 34, 2, 36, 39, 40, 41, 42, 43, 44, 45, 46, 47, 37, 37,
37, 37)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

seul les couleurs jusqu a 28 fonctionnent, y a t il un nombre limite de
valeur à mettre a la fonction array :-Z




Re,

Ce n'est pas vraiment qu'il ne fonctionne pas ;-))

Simplement la comparaison se fait avec les cellules de la ligne 4 de la
feuille active. Pour comparer avec les données de la feuille "Code",

remplace simplement la ligne

If c = Range("B4").Offset(0, i) Then

par

If c Sheets("Code").Range("B4").Offset(0,
i) Then

et code cette version modifiée dans le module de chacune des feuilles
mensuelles.

ou mieux,

copie ceci dans le module de chaque feuille mensuelle :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, i As Integer
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
Compare c
Next c
End If
End Sub

et cela dans un module standard :

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

L'intérêt est que si tu veux modifier les codes couleurs, tu n'auras à
le faire qu'une fois.



Bonjour Michel Gaboly,

En effet je suis debutant et j essaye de me prefectionner par le biaie
de ce forum.
J ai essaye ton code avec array :'( il ne fonctionne pas, en effet jai
un classeur avec une feuille par mois et une feuille qui me sert de
code.
Ce que je veux c est que si je mets en "B4" sur ma feuille "Code" la
lettre "G" par exemple et qu ensuite je saisi dans une de mes feuilles
mois dans une des cellules de la plages "C6:AG35" le valeurs "G" alors
la cellule se coloris d'une certaine couleur

merci

Michel Gaboly a exprimé avec précision :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'






Avatar
Jacquouille Le Gaulois
Jacquouille Le Gaulois avait prétendu :
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche pas
quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


Encore Moi :-X


suite au code que m'a gentillement fourni Philippe R et Michel Gaboly,
il subsiste un petit soucis!
est il possible que si l'on utilise pas tous les codes possibles donc
pas toutes les couleurs que la boucle For s'ajuste automatiquement

Merci

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(16, 17, 18, 19, 20, 0, 22, 23, 24, 0, 26, 27, 28, 29,
30, 31, 32, 33, 34, 0, 36, 39, 40, 41, 42, 43, 44, 45, 46, 47, 37, 37,
37, 37)
For i = 0 To 33
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'

1 2