modif macro ligne couleur legende

[almas]

Bonjour le forum

j 'ai besoins d un coup de pousse pour modifier un code VBA ( je n 'y arrive pas )

le code colorie une cellule en fonction d une légende

je voudrai réduire la recherche a la colonne E (de E3 a E... ) et colorier toute la ligne (via le code sans les mise en forme conditionnel)

le code actuel:

Private Sub Worksheet_Activate()

For Each c In [A1:F500]
On Error Resume Next
lig = Application.Match(c, Sheets("liste").[a4:a14], 0)
If lig = 0 Then
c.Interior.ColorIndex = xlNone
Else
c.Interior.Color = Sheets("liste").[a4].Offset(lig - 1, 0).Interior.Color
End If
lig = 0
Next c

End Sub


merci d avance

 

[thebenoit59]

Re : modif macro ligne couleur legende

Bonjour Almas.

Une autre solution :

Private Sub Worksheet_Activate()
Dim i As Long, d As Object
With Sheets("base")
Set d = CreateObject("Scripting.Dictionary")
    For i = 4 To 14
        d(.Cells(i, "H").Value) = .Cells(i, "H").Interior.Color
    Next i
    For i = 3 To .[e65000].End(xlUp).Row
        If Not d.exists(.Cells(i, 5).Value) Then
        .Range(.Cells(i, 1), .Cells(i, 5)).Interior.Color = xlNone
        Else:
        .Range(.Cells(i, 1), .Cells(i, 5)).Interior.Color = d(.Cells(i, 5).Value)
        End If
    Next i
End With
End Sub

 

[almas]

Re : modif macro ligne couleur legende

re
merci thebemoit59 c 'est ce que je voulais mais j 'ai besoin de comprendre quelque truc pour réadapter le code

les "Cells(i, 5)" le 5 est la colonne de recherche je suppose?

et si je veux que la legende soit dans la feuil "liste" je modifie :
With Sheets("base")
Set d = CreateObject("Scripting.Dictionary")
For i = 4 To 14
?

et pour colorier qu 'une partie de la ligne je modifie:
i = 3 To .[e65000].End(xlUp).Row
en effaçant le" . ROW"

 

[thebenoit59]

Re : modif macro ligne couleur legende

1. Oui, le 5 correspond au numéro de colonne, j'aurai pu mettre "E" à la place du 5.
2. Si tu souhaites avoir la légende en Feuille Liste, modifie le Sheets("base") par Sheets("liste"), et la colonne d'enregistrement H par A.
3. Non tu ne dois pas supprimer le .Row. [e65000].end(xlup).Row, est la dernière ligne remplie en colonne E.
Il faut travailler sur la ligne : .Range(.Cells(i, 1), .Cells(i, 5)).
Avec Cells(i, 1) = Cellule de la colonne A en ligne i, selon l'incrémentation de i.
Et Cells(i, 5) = Cellule de la colonne E

 

[almas]

Re : modif macro ligne couleur legende

merci de ces explication Thebenoit

1) nikel j 'ai remplacer par des lettre car plus lisible pour moi ^^

2) quand je modifie le Sheets("base") par Sheets("liste"), et la colonne d'enregistrement H par A le code marche plus ????

3) j 'ai essayer de jouer avec les colonne mais ca me donne un résultat inversé ^^ je voulais colorier de B a D et ca a fait l'inverse (je suis pas doué^^)

voila le new code:

Private Sub Worksheet_Activate()
Dim i As Long, d As Object
With Sheets("base")
Set d = CreateObject("Scripting.Dictionary")
For i = 4 To 14
d(.Cells(i, "h").Value) = .Cells(i, "h").Interior.Color
Next i
For i = 3 To .[E65000].End(xlUp).Row
If Not d.exists(.Cells(i, "B").Value) Then
.Range(.Cells(i, "B"), .Cells(i, "D")).Interior.Color = xlNone
Else:
.Range(.Cells(i, "B"), .Cells(i, "D")).Interior.Color = d(.Cells(i, "B").Value)
End If
Next i
End With
End Sub

 

[thebenoit59]

Re : modif macro ligne couleur legende

Effectivement, ça ne peut pas fonctionner.
Plusieurs erreurs se sont glissées dans tes modifications.
Voilà le code à jour, à toi de chercher les erreurs

Private Sub Worksheet_Activate()
Dim i As Long, d As Object
With Sheets("liste")
Set d = CreateObject("Scripting.Dictionary")
    For i = 4 To 14
        d(.Cells(i, "A").Value) = .Cells(i, "A").Interior.Color
    Next i
End With
With Sheets("base")
    For i = 3 To .[E65000].End(xlUp).Row
        If Not d.exists(.Cells(i, "E").Value) Then
        .Range(.Cells(i, "B"), .Cells(i, "D")).Interior.Pattern = xlNone
        Else:
        .Range(.Cells(i, "B"), .Cells(i, "D")).Interior.Color = d(.Cells(i, "E").Value)
        End If
    Next i
End With
End Sub

 

[almas]

Re : modif macro ligne couleur legende

parfait un gros merci a toi


oui effectivement l 'interior color me semblais qu 'il fallait que je fasse référence a la colonne recherché
et
If Not d.exists(.Cells(i, "E").Value) Then la en faite je prend l information du contenue de la cellule logique!

par contre pour l' onglet liste je comprend pas car il me semblais avoir fait exactement cela mais j 'avais du oublier un truc

je remet le fichier final qui marche cela peut intéresser d autre pour adaptation

MERCI ^^