XL 2010 Alerte si la valeur de deux cellules selectionner par couleur identique

[SSI83000]

Bonjour à tous je viens vous demander des conseilles sur mon projet.

j'ai une base de donnée qui comprte des noms dans différente colonne

pour ma feuille de garde je sélectionne grace à 3 couleur rouge jaune et Vert les fonctions de jours de mes pompiers.

pour éviter avoir des doublons sur ma feuille de garde exemple le mème jour un pompiers présent en CDP et CA
le souhaiterais une petite macro qui me dirait via un message attention double fonction et colorier en bleu la cellules pour que je puisse les changés

voir le fichier joins pouvez vous m'aider svp de préférence par macro en vue d'etre mis sur un bouton merci d'avance à vous

 

[pierrejean]

Bonjour,

A tester:

Sub test()
For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
 For m = 1 To 3
  If Cells(n, m).Interior.ColorIndex <> xlNone Then
    For p = m + 1 To 4
        If Cells(n, p).Interior.ColorIndex <> xlNone And Cells(n, p) = Cells(n, m) Then
              Cells(n, m).Interior.ColorIndex = 8
              Cells(n, p).Interior.ColorIndex = 8
        End If
    Next
  End If
 Next
Next
End Sub

 

[SSI83000]

bonjour pierrejean et merci pour ton aide tous fonctionne sauf quand je corrige l erreur et relance la macro il me recolorie ancienne erreur malgré qu'il soit corriger

 

[pierrejean]

Re

On peut avoir un exemple de fichier après correction

 

[SSI83000]

RE BONJOUR

en fait j'ai détecter deux soucis le premier si les deux non noloré est pas sur le même ligne la macro n'opére pas.
et quand la macro fonctionne si je corrige la macro change la valeur pour le remetre sur l'ancien et me recolorie en bleu

 

[pierrejean]

Re

Effectivement tu avais présenté un modèle ou les doublons sont sur la même ligne
Quant à la macro elle ne peut pas changer une valeur (uniquement une couleur de fond)
Je regarde à nouveau

 

[SSI83000]

ok merci infiniment

 

[pierrejean]

Re

A tester

 

[job75]

Bonjour SSI83000, salut Pierre,

Voyez le fichier joint et le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Const nlig& = 12 'hauteur des tableaux, modifiable
Const ncol% = 4 'largeur des tableaux, modifiable

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim d As Object, c As Range, x$, P As Range
If Target.Column > 1 Or (Target.Row - 1) Mod nlig Then Exit Sub
Cancel = True
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each c In Target.Resize(nlig, ncol)
  If c <> "" And c.Interior.ColorIndex <> xlNone Then
    x = c & Chr(1) & c.Interior.Color
    If d.exists(x) Then
      Set P = Union(Range(d(x)), IIf(P Is Nothing, c, P), c)
    Else
      d(x) = c.Address
    End If
  End If
Next
If P Is Nothing Then
  MsgBox "C'est tout bon...", , "Vérification des doublons"
Else
  P.FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI" 'création de la MFC
  P.FormatConditions(1).Interior.ColorIndex = 49 'bleu foncé
  P.FormatConditions(1).Font.ColorIndex = 2 'police blanche
  P.FormatConditions(1).Font.Bold = True 'gras
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[A:A].Resize(, ncol).FormatConditions.Delete 'RAZ
End Sub

Edit : j'ai un peu amélioré la 1ère macro.

A+

 

[SSI83000]

bonjour jobs et re à Pierre jean

merci pierre jean le problème semble être résolu une macro simple à adapter à mon projet parfait merci également à jobs75 je n'ai pas réussis à faire fonctionner ta macro mais je te remercie également avoir répondu à mon appel un grand merci à tous les deux de m'aider à avancer

 

[job75]

Re,

je n'ai pas réussis à faire fonctionner ta macro

C'est une macro évènementielle qui se lance par double-clic et pas par un bouton.

Tout le code doit être placé dans la feuille, comme je l'ai dit.

Et lisez les explications que j'ai données.

A+

 

[SSI83000]

bonjour pierrrejean j'ai essayer ta macro sur mon vrais fichier mais rien ne ce passe pourrais tu me dire ou il y a un problème svp merci

 

[pierrejean]

Re

Tu as conscience de la menue différence qui existe entre ta demande initiale et ton fichier réel ???
Dans ton cas il faut soit
1) proposer une copie de l’intégralité du fichier original (anonymisé bien sur)
2) Etre sur de sa capacité à adapter la solution proposée

NB : étudies bien les modifications que je te propose et tiens en compte si par exemple tu intitules Soir un tableau futur

 

[job75]

Bonjour SSI83000, salut Pierre,

Eh oui le code doit être modifié si l'on change la disposition ou les dimensions des tableaux.

Dans ce fichier (2) il y a un code différent dans chacune des 2 feuilles.

A+

 

[SSI83000]

Re je suis conscient qu'il y a une différence mais le fait d'avoir corrigé va m'aider à mieux comprendre la macro et l'adapter aux autre jour merci encore