XL 2016 vba pour chaque valeur égale à liste alors

[kro2b]

Bonjour le forum,

je ne suis pas à l'aise sur VBA. j'ai besoin de votre précieuse aide pour ce cas.
Je ne veux pas utiliser la Mise en Forme conditionnelle Excel car les couleurs et les noms seront modifiables.

Pour une liste de noms et affectation par région, je souhaiterais parvenir à reproduire la mise en forme (couleur cellule et police) pour chaque nom de la liste.
mon code n'est pas vraiment subtile et je pense devoir utiliser un 'For each'

le code que j'ai commencé marche bien sur 1 nom mais une boucle serait sans doute plus légère.
j'aimerai comprendre comment écrire que si une des valeur dans Range("C2:C32") est égale à la liste des nom Range("E2:E8") alors reproduit la mise en forme.

Je joins le résultat que je dois obtenir et ci-dessous mon début de code qui fonctionne pour 1 nom de la liste et son département.

Merci d'avance.

Sub couleursFormulaire()
Application.ScreenUpdating = False
Sheets("testA").Select

Range("ChampMFC").Select 'ici Range("C2:C32")
Dim Cel As Range
For Each Cel In Range("ChampMFC")

' ------------- Claire Jone --------------------------------
If Cel = "Claire Jone" Then
Range("E2").Copy 'copie mise en forme du nom pour le nom choisi
Cel.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("Claire Jone").Copy 'copie mise en forme département pour le nom choisi ** DP = 2 colonnes avant Noms**
Cel.Offset(, -2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End If
Next Cel

'Range("mfcDP").Font.Size = 18 'Range("A2:A32")

End Sub

 

[sylvanu]

Bonsoir Kro2b,
Vous n'auriez pas un petit fichier test, juste pour éviter de tout se retaper ?
Cela doit être faisable avec 2 boucles imbriquées. Une pour parcourir la liste, la seconde pour faire les identifications pour les couleurs.

 

[kro2b]

Bonsoir Kro2b,
Vous n'auriez pas un petit fichier test, juste pour éviter de tout se retaper ?
Cela doit être faisable avec 2 boucles imbriquées. Une pour parcourir la liste, la seconde pour faire les identifications pour les couleurs.

Bonsoir Sylvanu,
Merci pour votre retour, voici un petit fichier demandé.

 

[sylvanu]

Bonjour Kro2b,
Merci, c'est plus simple avec un fichier.
En PJ un essai.
La mise en couleur se fait à l'ouverture du fichier par, dans ThisWorkbook :

Private Sub Workbook_Open()
     MiseEnForme
End Sub

et par modification d'une cellule en automatique par, dans feuille Vu :

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("N4:V100")) Is Nothing Then
     MiseEnForme
    End If
End Sub
Sub MiseEnForme()
DerLig = Sheets("Vu").Range("P65500").End(xlUp).Row
For L = 4 To DerLig
    Colore L, 16
    Colore L, 19
    Colore L, 22
Next L
End Sub
Sub Colore(Ligne, Colonne)
    If Not IsError(Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)) Then
        Cells(Ligne, Colonne).Interior.Color = Range("Y" & Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)).Interior.Color
        Cells(Ligne, Colonne - 2).Interior.Color = Range("Y" & Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)).Interior.Color
    Else
        Cells(Ligne, Colonne).Interior.Color = RGB(255, 255, 255)
        Cells(Ligne, Colonne - 2).Interior.Color = RGB(255, 255, 255)
    End If
End Sub

 

[kro2b]

Bonjour Kro2b,
Merci, c'est plus simple avec un fichier.
En PJ un essai.
La mise en couleur se fait à l'ouverture du fichier par, dans ThisWorkbook :

Private Sub Workbook_Open()
     MiseEnForme
End Sub

et par modification d'une cellule en automatique par, dans feuille Vu :

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("N4:V100")) Is Nothing Then
     MiseEnForme
    End If
End Sub
Sub MiseEnForme()
DerLig = Sheets("Vu").Range("P65500").End(xlUp).Row
For L = 4 To DerLig
    Colore L, 16
    Colore L, 19
    Colore L, 22
Next L
End Sub
Sub Colore(Ligne, Colonne)
    If Not IsError(Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)) Then
        Cells(Ligne, Colonne).Interior.Color = Range("Y" & Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)).Interior.Color
        Cells(Ligne, Colonne - 2).Interior.Color = Range("Y" & Application.Match(Cells(Ligne, Colonne), [Y:Y], 0)).Interior.Color
    Else
        Cells(Ligne, Colonne).Interior.Color = RGB(255, 255, 255)
        Cells(Ligne, Colonne - 2).Interior.Color = RGB(255, 255, 255)
    End If
End Sub

Bonsoir et merci Sylvanu,

C'est vraiment fou ce code, léger et performant.
un grand merci; il est tout bonnement magnifique.
ça donne encore plus envie de s'y mettre sérieusement.

Je vais rajouter la mise au format de la police des noms et.. parfait.

Pour le code MiseEnForme, pourriez-vous m'expliquer ce que signifie les nombres 16,19,22 :
Colore L, 16
Colore L, 19
Colore L, 22

Merci encore

 

[sylvanu]

Bonsoir,
"Colore" est une macro qui est définie par :

Sub Colore(Ligne, Colonne)

En d'autres termes elle demande deux paramètres qui sont Le N° de ligne et le N° de colonne qu'elle doit traitée.
Donc Colore L,16 demande de traiter la cellule de coordonnées L ( calculée par For L = 4 To DerLig ) et de la colonne 16. 16 étant la 16eme colonne soit la colonne P.
Idem pour 19 colonne S et 22 colonne V.
Et on traite les colonnes (Colonne) et (Colonne-2) pour atteindre les colonnes N,Q et T.

 

[kro2b]

Bonsoir,
"Colore" est une macro qui est définie par :

Sub Colore(Ligne, Colonne)

En d'autres termes elle demande deux paramètres qui sont Le N° de ligne et le N° de colonne qu'elle doit traitée.
Donc Colore L,16 demande de traiter la cellule de coordonnées L ( calculée par For L = 4 To DerLig ) et de la colonne 16. 16 étant la 16eme colonne soit la colonne P.
Idem pour 19 colonne S et 22 colonne V.
Et on traite les colonnes (Colonne) et (Colonne-2) pour atteindre les colonnes N,Q et T.

Mais bien sûr, quelle idiote je suis ! comment louper ça. Désolée et merci encore

 

[sylvanu]

Errare humanum est.