VBA colorer cellule d'une colonne

Résolu

Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention -
Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention - 1 mars 2017 à 12:29

Bonjour à tous,
Il y a 2 mois, un utilisateur, que je remercie, m'avais donner un code pour qu'un même texte d'une cellule L et Q se mettent en couleur quand je double clique dessus.
Exemple : Quand je clique sur "Fabien" dans la col L ou Q tous les "Fabien" de Q et de L se colorent.
J'ai essayé de refaire pour les colonnes I et N en changeant les lettres du code, mais impossible de le faire marcher. Pouvez m'aidez a changer ce code en conservant tous sauf le nom des colonnes ? (je veux garder les numéros de lignes qui sont toujours identiques avec les colonnes I et N)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
derligL = Range("L" & Rows.Count).End(xlUp).Row
derligQ = Range("Q" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("L2:L" & derligL, "Q47:Q" & derligQ)) Is Nothing Then
Cancel = True
col = Target.Column
If col = 12 Then
D1 = 2: D2 = 47: Plage1 = "L2:L" & derligL: Plage2 = "Q47:Q" & derligQ: col2 = 17
Else
D1 = 47: D2 = 2: Plage1 = "Q47:Q" & derligQ: Plage2 = "L2:L" & derligL: col2 = 12
End If
Application.ScreenUpdating = False
Cel = Target.Value
Range(Plage1).Interior.Pattern = xlNone
Nb = Application.CountIf(Columns(col), Cel)
If Nb > 0 Then
lig = D1 'ligne de depart
For N = 1 To Nb
lig = Columns(col).Find(Cel, Cells(lig, col), , xlWhole).Row
If Cells(lig, col).Interior.Color = vbGreen Then
Cells(lig, col).Interior.Pattern = xlNone
Else
Cells(lig, col).Interior.Color = vbGreen
End If
Next N
End If
Range(Plage2).Interior.Pattern = xlNone
Nb = Application.CountIf(Columns(col2), Cel)
If Nb > 0 Then
lig = D2 'ligne de depart
For N = 1 To Nb
lig = Columns(col2).Find(Cel, Cells(lig, col2), , xlWhole).Row
If Cells(lig, col2).Interior.Color = vbGreen Then
Cells(lig, col2).Interior.Pattern = xlNone
Else
Cells(lig, col2).Interior.Color = vbGreen
End If
Next N
End If
End If
Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne Q et L pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
derligL = Range("L" & Rows.Count).End(xlUp).Row
derligQ = Range("Q" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("L2:L" & derligL, "Q47:Q" & derligQ)) Is Nothing Then
Cancel = True
Range("L2:L" & derligL).Interior.Pattern = xlNone
Range("Q47:Q" & derligQ).Interior.Pattern = xlNone
End If
End Sub

A voir également:

VBA colorer cellule d'une colonne
Déplacer une colonne excel - Guide
Trier une colonne excel - Guide
Comment colorer une cellule excel avec une formule si - Guide
Colonne word - Guide
Formule somme excel colonne - Guide

1 réponse

Réponse 1 / 1

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Vous voulez I et N en plus des L et Q ou ????

Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention

Bonsoir,
Non juste à la place car j'ai modifié mon tableur pour plus de simplicité.
Je pensais qu'ils fallait juste changer tous les L en I et les Q en N mais visiblement ça ne doit pas être aussi simple.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention

Re,
Ben, normalement, juste à remplacer comme vous l'avez écrit . C'est moi qui vous ait donné ce code. Je regarde ça demain matin si personne ne prend la suite
À+

Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

Re,
J'ai du raté quelques changements, j'avais juste réussi à changer Q en N. bizard... Je vais réessayer. Je remets un commentaire si j'y arrive pour ne pas vous déranger.

Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention

Après avoir changer les lettres, la colonne I ne fonctionne toujours pas. Est-je raté une étape ? surement...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
derligI = Range("I" & Rows.Count).End(xlUp).Row
derligN = Range("N" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("I2:I" & derligI, "N47:N" & derligN)) Is Nothing Then
Cancel = True
col = Target.Column
If col = 12 Then
D1 = 2: D2 = 47: Plage1 = "I2:I" & derligI: Plage2 = "N47:N" & derligN: col2 = 17
Else
D1 = 47: D2 = 2: Plage1 = "N47:N" & derligN: Plage2 = "I2:I" & derligI: col2 = 12
End If
Application.ScreenUpdating = False
Cel = Target.Value
Range(Plage1).Interior.Pattern = xlNone
Nb = Application.CountIf(Columns(col), Cel)
If Nb > 0 Then
lig = D1 'ligne de depart
For N = 1 To Nb
lig = Columns(col).Find(Cel, Cells(lig, col), , xlWhole).Row
If Cells(lig, col).Interior.Color = vbGreen Then
Cells(lig, col).Interior.Pattern = xlNone
Else
Cells(lig, col).Interior.Color = vbGreen
End If
Next N
End If
Range(Plage2).Interior.Pattern = xlNone
Nb = Application.CountIf(Columns(col2), Cel)
If Nb > 0 Then
lig = D2 'ligne de depart
For N = 1 To Nb
lig = Columns(col2).Find(Cel, Cells(lig, col2), , xlWhole).Row
If Cells(lig, col2).Interior.Color = vbGreen Then
Cells(lig, col2).Interior.Pattern = xlNone
Else
Cells(lig, col2).Interior.Color = vbGreen
End If
Next N
End If
End If
Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne I et N pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
derligI = Range("I" & Rows.Count).End(xlUp).Row
derligN = Range("N" & Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, Range("I2:I" & derligI, "N47:N" & derligN)) Is Nothing Then
Cancel = True
Range("I2:I" & derligI).Interior.Pattern = xlNone
Range("N47:N" & derligN).Interior.Pattern = xlNone
End If
End Sub

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Loriiiis Messages postés 20 Date d'inscription Statut Membre Dernière intervention

Bonjour,

Est-je raté une étape ? surement...
Un leger detail:

If col = 12 Then     'colonne L, I c'est 9

Discussions similaires

Excel : colorer une cellule sous condition d'une autre ?

Changer la couleur d'une cellule en fonction d'une autre cellule

Changer la couleur d'une cellule selon son texte

Votre réponse

Discussions similaires