Discussion :

[DESIRE39]

Bonjour,
j'aimerais votre aide, puis je faire ressortir des données communes avec plusieurs dates, sachant que celle ci sont variable (donné et dates)dans un tableau de 200 à plus de lignes
merci pour votre aide

[QuestVba]

Bonjour,

Oui c'est possible mais il faudra en dire plus pour une réponse plus précise.

[DESIRE39]

bonjour, merci pour ta réponse
voici un exemple de mon fichier de ce que je voudrais.
je ne sais si je suis clair dans ma demande.

[papouclo]

Bonjour,
A partir du moment où l'on veut manipuler des couleurs, il vaut certainement mieux utiliser du VBA mais voici en feuille 2 du classeur joint un essai sans code.
Il s'appuie sur des MFC et un certain nombre de colonnes intermédiaires (B à F et O à U) masquées mais qu'il vaut mieux afficher pour comprendre la démarche.
Il est important d'ordonner les règles de MFC et de cocher pour chaque règle la case Interrompre si vrai.
Cordialement
Claude

[QuestVba]

Bonjour,

Voici également un essaie avec le code suivant :

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
Sub Coloriage()
 
Sheets("Essai").Activate
 
c = 0
Plage = ""
For i = 1 To 40
'Repérage des X dans la colonne A pour définir la plage
    If Cells(8 + i, 1).Value = "X" Then
        If c = 0 Then
        Plage = "C" & 8 + i & ":" & "H" & 8 + i
        Else
        Plage = Plage & "," & "C" & 8 + i & ":" & "H" & 8 + i
        End If
    c = c + 1
    End If
Next i
'Coloriage
With Range(Plage)
    .FormatConditions.AddUniqueValues
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    'Utilisez xlUnique pour identifier les valeurs uniques
    .FormatConditions(1).DupeUnique = xlDuplicate
    .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
End With
 
End Sub

[DESIRE39]

Bonjour, je vous remercie pour vos réponse cependant je n'arrive pas à ouvrir le fichier associé QUESTVBA merci

[QuestVba]

Est-ce mieux ?

[DESIRE39]

bonjour, si je change les croix ou je mets d'autres données la macro ne s'applique pas au changement. ou je ne sais faire merci pour votre aide

[QuestVba]

Bonjour,

Dans mon fichier, je fonctionne avec :

1. Il faut mettre une 'X' (et non une 'x'); attention à la majuscule
2. Je tourne sur les lignes 9>48; il faut modifier si tu en as plus.

[DESIRE39]

bonjour, j'ai chercher comment modifier mais je n'ai pas réussi
je voudrais l'appliquer sur 200 lignes environ
et rajouter une colonne qui me sert de repert en A mais je ne connais tres peu de chose en macro merci

[QuestVba]

Bonjour,

J'ai un peu changer le code. Maintenant, il commence la boucle à la ligne 9 et continue jusqu'à la première ligne vide. Et il repère les 'X' et les 'x'.

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
Sub Coloriage()
 
Sheets("Essai").Activate
c = 0
li = 9
Plage = ""
 
    Do
        'Repérage des 'X' et 'x' dans la colonne A pour définir la plage
        If Cells(li, 1).Value = "X" Or Cells(li, 1).Value = "x" Then
            If c = 0 Then
                Plage = "C" & li & ":" & "H" & li
            Else
                Plage = Plage & "," & "C" & li & ":" & "H" & li
            End If
        c = c + 1
        End If
    li = li + 1
    Loop Until Range("B" & li).Value = ""
 
With Range(Plage)
    .FormatConditions.AddUniqueValues
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    'Utilisez xlUnique pour identifier les valeurs uniques
    .FormatConditions(1).DupeUnique = xlDuplicate
    .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
End With
 
End Sub

[Invité]

bonjour,

Code :

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

 If Ucase(Cells(li, 1).Value )= "X"  Then

[DESIRE39]

bonjour, peut on mettre plusieur couleur au lieu du rouge pour la totalite afin de repere plus facilement quel numero va avec quel ligne, et pouvoir effacer si je modifie ma recherche, merci

[QuestVba]

Bon ben j'ai adapté la macro. Plusieurs souleurs, c'est bien si tu n'en as pas beaucoup sinon cela devient un arc en ciel pas très beau. Donc, la macro fait ceci:

• Repérage des X et des x
• Récupération des doublons et mise au vert
• Mise dans la feuille de rapport les valeurs multiples et les adresses
• Tri des valeurs

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Coloriage()
 
Sheets("Essai").Activate
c = 0
li = 9
Plage = ""
 
    Do
        'Repérage des 'X' et 'x' dans la colonne A pour définir la plage
        If Cells(li, 1).Value = "X" Or Cells(li, 1).Value = "x" Then
            If c = 0 Then
                Plage = "C" & li & ":" & "H" & li
            Else
                Plage = Plage & "," & "C" & li & ":" & "H" & li
            End If
        c = c + 1
        End If
    li = li + 1
    Loop Until Range("B" & li).Value = ""
 
 
'
Dim mondico As Object, cc
  [C:H].Interior.ColorIndex = xlNone
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each cc In Range(Plage)
     mondico.Item(cc.Value) = mondico.Item(cc.Value) + 1
  Next cc
  'coloriage en vert de tous les doublons
  For Each cc In Range(Plage)
    If mondico.Item(cc.Value) > 1 Then cc.Interior.ColorIndex = 4
  Next cc
 
 
'Dans la feuille rapport, on indique les doublons et les adresses des cellules
Sheets("Rapport").Range("a2:b" & Range("B" & Rows.Count).End(xlUp).Row).Clear
ligne = 2
For Each Cell In Sheets("Essai").Range(Plage)
If Cell.Interior.Color = 65280 Then
    Sheets("Rapport").Cells(ligne, 1).Value = Cell.Value
    Sheets("Rapport").Cells(ligne, 2).Value = Cell.Address
    ligne = ligne + 1
End If
Next Cell
'on trie par valeur croissante
Sheets("Rapport").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Rapport").Sort
        .SetRange Range("a2:b" & Range("B" & Rows.Count).End(xlUp).Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub