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 Colorer les cellules à valeur Unique

Colorer les cellules à valeur Unique

14 réponses
Avatar
GVA
Bonjour,
j'ai dans la colonne A des numéros de dossier et dans la colonne B des
séquences de 1 à x.

A B
Dossier Séq
10000 1
10001 2
10002 1
10003 1
10003 2

Je souhaite que les cellules de la colonne A, contenant une valeur unique
(par exemple 1002 ci-dessus ) soient colorées.

Une idée :? Merci
Signaler un problème avec ce contenu

4 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
GVA
Merci pour tout michdenis, ça à l'air de tourner
En attendant de mon côté j'ai écrit ça et ça c'est basique mais ça tourne.

Merci à tous pour votre disponibilité.
Excellente soirée





Sub yaca()
Dim Cell As Range, Plage As Range, val As String, val2 As String, val3 As
String

On Error Resume Next
Set Plage = Range("C2:C8000")

For Each Cell In Plage
val = Cell.Value 'valeur de la cellule actuelle
val2 = Cell.Offset(1, 0).Value 'valeur de la cellule du dessous
val3 = Cell.Offset(-1, 0).Value 'valeur de la cellule du dessus

If val = val2 Or val = val3 Then 'si est égale à la cellule du
dessus ou dessous ne colorie pas

Else 'sinon colorie
Cell.Interior.ColorIndex = 4
End If

Next Cell


End Sub


"MichDenis" a écrit dans le message de news:

Il y a une petite coquille dans le If remplace le tout
par ceci ... il manque le Else ...

If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
Else
c.Interior.ColorIndex = xlAutomatic
End If




"MichDenis" a écrit dans le message de groupe de
discussion :
#
En vba, tu as ceci :

Tu colles ce qui suit dans le module feuille où l'action se déroule.

'---------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Set Rg = Intersect(Target, Range("A:A"))
If Not Rg Is Nothing Then
For Each c In Rg
If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
End If
Next
End If
End Sub
'---------------------------------



"GVA" a écrit dans le message de groupe de discussion :

Merci, j'ai testé mais ça toune pas comme je veux, car en cas d'insertion
de
ligne la condition n'est pas reprise.


J'ai trouvé ça qui fonctionne presque!

Sub doubles()
Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next
Set Plage = Range("C2:C5000")
'If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear

Cell.Interior.ColorIndex = 3

Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
End Sub

Presque car la première fois qu'il trouve une valeur il la considère come
unique. donc ça fait pas mon affaire.
En fait il colorie en rouge les doublons.












"Jacky" a écrit dans le message de news:

Re...
10000 10001 et 10002 sont uniques donc colorés:



Dans ce cas la proposition de MichDenis est ce qu'il te faut.

--
Salutations
JJ


"GVA" a écrit dans le message de news:

Bonjour Jacky,
Merci pour la réponse, c'est certain que si je me trompe dans mon
exemple
ça va pas le faire
voici la correction
A B
Dossier Séq
10000 1
10001 1
10002 1
10003 1
10003 2

10000 10001 et 10002 sont uniques donc colorés:
10003 y figure deux fois donc pas coloré.

Merci du coup de main





"Jacky" a écrit dans le message de news:
%
Bonjour,
Peux-tu préciser ta demande par un exemple
car si se sont les valeurs uniques de la colonne A ceci est faux
(par exemple 1002 ci-dessus ) soient colorées.


10000 , 10001 et 10002 sont uniques
???
Ou si tu souhaites les valeurs unique colonne A ayant une séquence
unique (Colonne B)
Dans ce cas
10000 et 10002
--
Salutations
JJ


"GVA" a écrit dans le message de news:
uZd2fy$
Bonjour,
j'ai dans la colonne A des numéros de dossier et dans la colonne B des
séquences de 1 à x.

A B
Dossier Séq
10000 1
10001 2
10002 1
10003 1
10003 2

Je souhaite que les cellules de la colonne A, contenant une valeur
unique (par exemple 1002 ci-dessus ) soient colorées.

Une idée :? Merci


















Avatar
GVA
J'avais pas testé jusque là ;-)
mais ce que j'ai fait (voir au dessus) est ferrnaté à chaque ouverture de
classeur
donc ça fonctionne bien.

Merci pour ton aide

"MichDenis" a écrit dans le message de news:
%
OUPs, la proposition faite est inexacte dans le cas où tu supprimes
des données... il se peut alors que des cellules déjà saisies se
retrouvent comme valeur unique dans la colonne.
Il y a aussi la situation... si tu avais une valeur unique et que
tu ajoutes plus loin dans la colonne la même valeur, la procédure
n'a aucun effet sur la première occurrence du doublon et le
format continue à s'appliquer... ce n'est pas probablement ce que tu
désires !

Conclusion : oublie ce que j'ai proposé.



"GVA" a écrit dans le message de groupe de discussion :

Merci, j'ai testé mais ça toune pas comme je veux, car en cas d'insertion
de
ligne la condition n'est pas reprise.


J'ai trouvé ça qui fonctionne presque!

Sub doubles()
Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next
Set Plage = Range("C2:C5000")
'If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear

Cell.Interior.ColorIndex = 3

Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
End Sub

Presque car la première fois qu'il trouve une valeur il la considère come
unique. donc ça fait pas mon affaire.
En fait il colorie en rouge les doublons.












"Jacky" a écrit dans le message de news:

Re...
10000 10001 et 10002 sont uniques donc colorés:



Dans ce cas la proposition de MichDenis est ce qu'il te faut.

--
Salutations
JJ


"GVA" a écrit dans le message de news:

Bonjour Jacky,
Merci pour la réponse, c'est certain que si je me trompe dans mon
exemple
ça va pas le faire
voici la correction
A B
Dossier Séq
10000 1
10001 1
10002 1
10003 1
10003 2

10000 10001 et 10002 sont uniques donc colorés:
10003 y figure deux fois donc pas coloré.

Merci du coup de main





"Jacky" a écrit dans le message de news:
%
Bonjour,
Peux-tu préciser ta demande par un exemple
car si se sont les valeurs uniques de la colonne A ceci est faux
(par exemple 1002 ci-dessus ) soient colorées.


10000 , 10001 et 10002 sont uniques
???
Ou si tu souhaites les valeurs unique colonne A ayant une séquence
unique (Colonne B)
Dans ce cas
10000 et 10002
--
Salutations
JJ


"GVA" a écrit dans le message de news:
uZd2fy$
Bonjour,
j'ai dans la colonne A des numéros de dossier et dans la colonne B des
séquences de 1 à x.

A B
Dossier Séq
10000 1
10001 2
10002 1
10003 1
10003 2

Je souhaite que les cellules de la colonne A, contenant une valeur
unique (par exemple 1002 ci-dessus ) soient colorées.

Une idée :? Merci


















Avatar
MichDenis
Ceci fonctionne très bien !
Tu places ce code dans le module feuille où l'action se déroule.
Tu devras faire des adaptations le cas échéant.
J'utilise le filtre élaboré... ce dernier requiert une étiquette
de colonne obligatoire
J'ai choisi comme zone de critère D1:D2, tu peux prendre
2 cellules de ton choix... et j'ai supposé que l'action se déroulait
en colonne A:A
'--------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Rg1 As Range

If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
With Range("A1:A" & Range("A65536").End(xlUp).Row)
'Zone de critère du filtre élaboré D1:D2
Range("D1") = ""
Range("D2").Formula = "=Countif(" & .Cells.Address & ",A2)=1"
.Interior.ColorIndex = xlNone
.AdvancedFilter (xlFilterInPlace), Range("D1:D2"), , True
Set Rg = Range("_FilterDataBase")
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Rg1.Interior.ColorIndex = 3
.Parent.ShowAllData
Range("D1") = ""
Range("D2") = ""
End With
Application.EnableEvents = True
End If

End Sub
'--------------------------------



"GVA" a écrit dans le message de groupe de discussion :
#
Merci pour tout michdenis, ça à l'air de tourner
En attendant de mon côté j'ai écrit ça et ça c'est basique mais ça tourne.

Merci à tous pour votre disponibilité.
Excellente soirée





Sub yaca()
Dim Cell As Range, Plage As Range, val As String, val2 As String, val3 As
String

On Error Resume Next
Set Plage = Range("C2:C8000")

For Each Cell In Plage
val = Cell.Value 'valeur de la cellule actuelle
val2 = Cell.Offset(1, 0).Value 'valeur de la cellule du dessous
val3 = Cell.Offset(-1, 0).Value 'valeur de la cellule du dessus

If val = val2 Or val = val3 Then 'si est égale à la cellule du
dessus ou dessous ne colorie pas

Else 'sinon colorie
Cell.Interior.ColorIndex = 4
End If

Next Cell


End Sub


"MichDenis" a écrit dans le message de news:

Il y a une petite coquille dans le If remplace le tout
par ceci ... il manque le Else ...

If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
Else
c.Interior.ColorIndex = xlAutomatic
End If




"MichDenis" a écrit dans le message de groupe de
discussion :
#
En vba, tu as ceci :

Tu colles ce qui suit dans le module feuille où l'action se déroule.

'---------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Set Rg = Intersect(Target, Range("A:A"))
If Not Rg Is Nothing Then
For Each c In Rg
If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
End If
Next
End If
End Sub
'---------------------------------



"GVA" a écrit dans le message de groupe de discussion :

Merci, j'ai testé mais ça toune pas comme je veux, car en cas d'insertion
de
ligne la condition n'est pas reprise.


J'ai trouvé ça qui fonctionne presque!

Sub doubles()
Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next
Set Plage = Range("C2:C5000")
'If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear

Cell.Interior.ColorIndex = 3

Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
End Sub

Presque car la première fois qu'il trouve une valeur il la considère come
unique. donc ça fait pas mon affaire.
En fait il colorie en rouge les doublons.












"Jacky" a écrit dans le message de news:

Re...
10000 10001 et 10002 sont uniques donc colorés:



Dans ce cas la proposition de MichDenis est ce qu'il te faut.

--
Salutations
JJ


"GVA" a écrit dans le message de news:

Bonjour Jacky,
Merci pour la réponse, c'est certain que si je me trompe dans mon
exemple
ça va pas le faire
voici la correction
A B
Dossier Séq
10000 1
10001 1
10002 1
10003 1
10003 2

10000 10001 et 10002 sont uniques donc colorés:
10003 y figure deux fois donc pas coloré.

Merci du coup de main





"Jacky" a écrit dans le message de news:
%
Bonjour,
Peux-tu préciser ta demande par un exemple
car si se sont les valeurs uniques de la colonne A ceci est faux
(par exemple 1002 ci-dessus ) soient colorées.


10000 , 10001 et 10002 sont uniques
???
Ou si tu souhaites les valeurs unique colonne A ayant une séquence
unique (Colonne B)
Dans ce cas
10000 et 10002
--
Salutations
JJ


"GVA" a écrit dans le message de news:
uZd2fy$
Bonjour,
j'ai dans la colonne A des numéros de dossier et dans la colonne B des
séquences de 1 à x.

A B
Dossier Séq
10000 1
10001 2
10002 1
10003 1
10003 2

Je souhaite que les cellules de la colonne A, contenant une valeur
unique (par exemple 1002 ci-dessus ) soient colorées.

Une idée :? Merci


















Avatar
GVA
Super Merci,

Pas encore eu le temps de tester...
A bientôt



"MichDenis" a écrit dans le message de news:

Ceci fonctionne très bien !
Tu places ce code dans le module feuille où l'action se déroule.
Tu devras faire des adaptations le cas échéant.
J'utilise le filtre élaboré... ce dernier requiert une étiquette
de colonne obligatoire
J'ai choisi comme zone de critère D1:D2, tu peux prendre
2 cellules de ton choix... et j'ai supposé que l'action se déroulait
en colonne A:A
'--------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, Rg1 As Range

If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
With Range("A1:A" & Range("A65536").End(xlUp).Row)
'Zone de critère du filtre élaboré D1:D2
Range("D1") = ""
Range("D2").Formula = "=Countif(" & .Cells.Address & ",A2)=1"
.Interior.ColorIndex = xlNone
.AdvancedFilter (xlFilterInPlace), Range("D1:D2"), , True
Set Rg = Range("_FilterDataBase")
Set Rg1 = Rg.Offset(1).Resize(Rg.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
Rg1.Interior.ColorIndex = 3
.Parent.ShowAllData
Range("D1") = ""
Range("D2") = ""
End With
Application.EnableEvents = True
End If

End Sub
'--------------------------------



"GVA" a écrit dans le message de groupe de discussion :
#
Merci pour tout michdenis, ça à l'air de tourner
En attendant de mon côté j'ai écrit ça et ça c'est basique mais ça tourne.

Merci à tous pour votre disponibilité.
Excellente soirée





Sub yaca()
Dim Cell As Range, Plage As Range, val As String, val2 As String, val3 As
String

On Error Resume Next
Set Plage = Range("C2:C8000")

For Each Cell In Plage
val = Cell.Value 'valeur de la cellule actuelle
val2 = Cell.Offset(1, 0).Value 'valeur de la cellule du dessous
val3 = Cell.Offset(-1, 0).Value 'valeur de la cellule du dessus

If val = val2 Or val = val3 Then 'si est égale à la cellule du
dessus ou dessous ne colorie pas

Else 'sinon colorie
Cell.Interior.ColorIndex = 4
End If

Next Cell


End Sub


"MichDenis" a écrit dans le message de news:

Il y a une petite coquille dans le If remplace le tout
par ceci ... il manque le Else ...

If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
Else
c.Interior.ColorIndex = xlAutomatic
End If




"MichDenis" a écrit dans le message de groupe de
discussion :
#
En vba, tu as ceci :

Tu colles ce qui suit dans le module feuille où l'action se déroule.

'---------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Set Rg = Intersect(Target, Range("A:A"))
If Not Rg Is Nothing Then
For Each c In Rg
If Application.WorksheetFunction.CountIf(Range("A:A"), c) = 1 Then
'modification de la couleur de fond
c.Interior.Color = vbRed
End If
Next
End If
End Sub
'---------------------------------



"GVA" a écrit dans le message de groupe de discussion :

Merci, j'ai testé mais ça toune pas comme je veux, car en cas d'insertion
de
ligne la condition n'est pas reprise.


J'ai trouvé ça qui fonctionne presque!

Sub doubles()
Dim Collec As New Collection, Cell As Range, Plage As Range

On Error Resume Next
Set Plage = Range("C2:C5000")
'If IsEmpty(Plage) Then Exit Sub

For Each Cell In Plage
If Cell.Value <> "" Then
Collec.Add Cell.Value, CStr(Cell.Value)
If Err <> 0 Then
Err.Clear

Cell.Interior.ColorIndex = 3

Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
End Sub

Presque car la première fois qu'il trouve une valeur il la considère come
unique. donc ça fait pas mon affaire.
En fait il colorie en rouge les doublons.












"Jacky" a écrit dans le message de news:

Re...
10000 10001 et 10002 sont uniques donc colorés:



Dans ce cas la proposition de MichDenis est ce qu'il te faut.

--
Salutations
JJ


"GVA" a écrit dans le message de news:

Bonjour Jacky,
Merci pour la réponse, c'est certain que si je me trompe dans mon
exemple
ça va pas le faire
voici la correction
A B
Dossier Séq
10000 1
10001 1
10002 1
10003 1
10003 2

10000 10001 et 10002 sont uniques donc colorés:
10003 y figure deux fois donc pas coloré.

Merci du coup de main





"Jacky" a écrit dans le message de news:
%
Bonjour,
Peux-tu préciser ta demande par un exemple
car si se sont les valeurs uniques de la colonne A ceci est faux
(par exemple 1002 ci-dessus ) soient colorées.


10000 , 10001 et 10002 sont uniques
???
Ou si tu souhaites les valeurs unique colonne A ayant une séquence
unique (Colonne B)
Dans ce cas
10000 et 10002
--
Salutations
JJ


"GVA" a écrit dans le message de news:
uZd2fy$
Bonjour,
j'ai dans la colonne A des numéros de dossier et dans la colonne B
des
séquences de 1 à x.

A B
Dossier Séq
10000 1
10001 2
10002 1
10003 1
10003 2

Je souhaite que les cellules de la colonne A, contenant une valeur
unique (par exemple 1002 ci-dessus ) soient colorées.

Une idée :? Merci





















1 2