Discussion :

[pilou10]

bonjour et merci pour votre aide

voila ce que je voudrai faire c'est de colorier les valeur dans une plage défini

je me suis ligoté ce programme

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
Sub Doublons()
Dim Collec As New Collection, Cell As Range, Plage As Range
 
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
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

deux chose que voudrais évité c le form qui apparais et l'autre c'est que je n'ai qu'une seule cellule qui
ce colore

par ex: dans cette liste

A1=1 B1=5 C1=15 D1=2 E1=5 F1=12 G1=5 H1=1

1 5 15 2 5 12 5 1

et j'aimerai colorié les valeurs (A1=1 H1=1) (B1=5 E1=5 G1=5)
merci par avance pour vos reponse

[Menhir]

Pour faire ça, tu n'as pas besoin de macro. La mise en forme conditionnelle fait ça très bien.

Ruban Accueil > Mise en forme conditionnelle > Règles de mise en surbrillance des cellules > Valeurs en double

[pilou10]

je sais le faire mais en vba serai un plus parce que excel 2010 a tendance a remettre une 2eme fois la même conditionnelle
un bug que j'ai remarqué a plusieurs reprise en fouillant dans les gestions vous allez peut être pas me le croire c'est pourtant vrai!

[arosec]

Bonsoir,

J'ai modifié 2 ou 3 choses dans la macro d'origine...
J'espère que cela t'aidera.

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
 
Sub Doublons()
Dim Cell As Range
Dim Plage As Range
 
  Set Plage = Application.InputBox("Plage à examiner", Type:=8)
  If Not IsEmpty(Plage) Then
    For Each Cell In Application.InputBox("Plage à examiner", Type:=8)
      If WorksheetFunction.CountIf(Plage, Cell.Value) > 1 Then
        Cell.Interior.ColorIndex = 3
      Else
        Cell.Interior.ColorIndex = 4
      End If
    Next Cell
  End If
  Set Plage = Nothing
 
End Sub

Cdlt,

[pilou10]

Merci arosec mais il y a tjr la boite qui apparait et pour le cas de trois doubons ce n'est pas résolu

[pilou10]

j'ai trouvé ce code qui fonctionne comme je voulais

voici le code si ça peut vous intéresser

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
Sub Doublon()
 
Dim plage As Range, c As Range
 
Set plage = Range("B18:H18") 'a adapter
 
For Each c In plage
    If Not c = "" Then
        If Application.CountIf(plage, c) > 1 Then
            c.Interior.ColorIndex = 1
            c.Font.ColorIndex = 2
        Else
            c.Interior.ColorIndex = 6
            c.Font.ColorIndex = 1
        End If
    End If
Next c
 
end sub

ce code j'aimerais l'appliqué a plusieurs lignes serait-il possible a le faire
en faisant en une seule boucle c'est a dire de la ligne B18 à B33