Discussion :

[benzot]

Bonjour,

j'arrive sans soucis à faire changer la couleur d'une cellule si doublon mais pas à solutionner mon problème.

Voila dans une colonne définie, je cherche à trouver si une cellule est identique (en texte) à une autre mais si seulement ce texte fait parti d'une liste définie.

et de ce fait, si vrai que le fond de la cellule est changer pour m'avertir.


merci beaucoup

[casefayere]

Bonjour,
Si j'ai compris, ci-dessous un exemple à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Test_doublons()
Dim DL As Long
With Sheets("Feuil1") 'à adapter bonne feuille
   DL = .Range("A" & .Rows.Count).End(xlUp).Row ' à adapter à la bonne colonne
   IdentifieDoublons Range("A2:A" & DL)
End With
End Sub
 
Sub IdentifieDoublons(Plg As Range)
Dim Un As Collection, cel As Range, liste, x As Long
Set Un = New Collection
With Sheets("Feuil1") 'à adapter bonne feuille
  x = .Range("D" & .Rows.Count).End(xlUp).Row
  liste = .Range("D2", "D" & x) 'liste définie en D
  For Each cel In Plg
    On Error Resume Next
    Un.Add cel, CStr(cel)
    If Err <> 0 Then
      On Error GoTo 0
      For x = 1 To UBound(liste, 1)
        If cel = liste(x, 1) Then
          cel.Interior.ColorIndex = 7
          Exit For
        Else
          cel.Interior.ColorIndex = 2
        End If
      Next x
    End If
  Next cel
End With
Set Un = Nothing
End Sub

[benzot]

Merci Casefayere,

j'ai test dans un module et je l'ai exécuté.

J'ai quelques soucis :

-La macro est longue à s'exécutée
-elle me modifie la mise en forme des autres cellules
-lorsque que je sélectionne un doublon, et que je change sa valeur la couleur de doublon reste.
-la zone d'action de mes 3 colonnes par feuille ("b12":"b53") puis ("n12":"b53") et ("z12":"z53")

Possible de l'appliquer sur 3 autres tableaux par feuille (soit 7 feuilles)

Thanks

[casefayere]

Je ne pourrais plus regarder avant ce soir, il faudrait que tu joignes un fichier Bidon et je devrais pouvoir mieux cerner et accélérer la procédure

[benzot]

Bonsoir,

voila enfin l'exemple

http://www.developpez.net/forums/att...est-copie.xls/
je cherche à avoir exactement dans 3 tableaux, 2 boutons qui vérifie chacun une colonne définie selon une liste (cette liste se trouvera dans la 1ere feuille) de critères communes .

bouton1 -> col B (sur un nombre de ligne définie)
vouton2 -> col C ""
bouton3 -> col N ""
bouton4 -> col O ""
bouton5 -> col Z ""
bouton6 -> col AA ""

Merci

[nibledispo]

Bonjour,

Sois un peu plu précis.

- nom de la feuille contenant la liste(s) (1ère feuille ?)
- liste(s) située dans quelle colonne(s) de la feuille.
- ligne de départ et ligne de fin de liste.

cordialement,

[benzot]

Bonsoir,

- nom de la feuille contenant la liste(s) (1ère feuille ?)

1er choix (préférence): feuille REGLAGES (servira pour tout les tableaux dans les feuilles suivante nommées de Lundi à dimanche).
ou
2eme choix : dans chaque feuille active (lundi, etc...).

- liste(s) située dans quelle colonne(s) de la feuille.

1er choix : colonne R (dans la feuille REGLAGES).
ou
2eme choix : colonne BB (de chaque feuille active)

- ligne de départ et ligne de fin de liste.

1er choix : ligne 1 à 44
ou
2eme choix : ligne 148 à 192

Merci

[benzot]

Bonsoir,
J'ai mis cette macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub ColoriageDoublons()
   ActiveSheet.Unprotect
   Set mondico = CreateObject("Scripting.Dictionary")
   For Each c In Range("b12:c53")
     If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
   Next c
   For Each c In Range("b12:c53")
     If mondico.Item(c.Value) > 1 Then c.Font.ColorIndex = 5
   Next c
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 End Sub

elle fonctionne correctement mais elle prend en compte tout les critères identiques.

C'est possible de mettre une condition (ajout d'une liste de critères définies ) ?

Bonne soirée et bon weekend

[nibledispo]

Bonsoir,

tu n'as pas à te préoccuper de la liste. dans la liste de validation, à la conception, limite la saisie aux seules valeurs de la liste en sélectionnant:
- dans le premier onglet "liste" (origine des données)
- dans le troisième onglet "ARRET" et en ajoutant ton message d'erreur.

Ainsi aucune valeur hors liste ne pourra être saisie.

Cordialement,

[benzot]

Bonjour,

En faite, j'ai certain terme qui sont listés et qui sont répétés (j'en ai besoin) mais qui n'ont pas besoin d'être repérés comme doublons.

seuls certains termes doivent apparaitre une fois.

----------------------------------------------
A la base, je voulais créer des listes déroulante dynamique qui se mettent à jour au fur et à mesure (dès qu'un terme est choisi dans la première cellule que dans la suivante ce terme ne soit plus disponible) afin d'éviter la recherche de doublons.


Bon dimanche

[benzot]

Bonsoir,

J'ai retesté le code de Casefayere mais c'est pas encore ce que je souhaite.

Cela trouve bien les doublons mais également ceux qui ne sont pas listés, pourtant la liste est bien définie en sheets("divers") en range ("o2:o48")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Doublons715()
 Dim DL As Long
With Sheets("test")  'à adapter bonne feuille
DL = .Range("b12:c53").End(xlUp).Row ' à adapter à la bonne colonne
IdentifieDoublons Range("b12:c53")
End With
End Sub
 
Sub IdentifieDoublons(Plg As Range)
ActiveSheet.Unprotect
Dim Un As Collection, cel As Range, x As Long
Set Un = New Collection
With Sheets("divers") 'à adapter bonne feuille
  x = .Range("o2:o48").End(xlUp).Row
  For Each cel In Plg
    On Error Resume Next
    Un.Add cel, CStr(cel)
    If Err <> 0 Then
      On Error GoTo 0
        If cel = x > 1 Then
          cel.Font.ColorIndex = 5
          Exit For
        Else
          cel.Font.ColorIndex = 5
        End If
      End If
  Next cel
End With
Set Un = Nothing
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 End Sub

CDT