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

SSI83000

XLDnaute Occasionnel
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
 

Pièces jointes

  • Essais1.xlsx
    10.2 KB · Affichages: 42

pierrejean

XLDnaute Barbatruc
Bonjour,

A tester:

Code:
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • Essais1.xlsm
    16.7 KB · Affichages: 43

job75

XLDnaute Barbatruc
Bonjour SSI83000, salut Pierre,

Voyez le fichier joint et le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
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+
 

Pièces jointes

  • Vérifications des doublons(1).xlsm
    27.5 KB · Affichages: 28
Dernière édition:

SSI83000

XLDnaute Occasionnel
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
 

pierrejean

XLDnaute Barbatruc
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
 

Pièces jointes

  • Copie de Essais1-1 (1).xlsm
    46.9 KB · Affichages: 40

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Vérification des doublons(2).xlsm
    35.1 KB · Affichages: 30

Discussions similaires

Statistiques des forums

Discussions
312 932
Messages
2 093 733
Membres
105 802
dernier inscrit
Witchun