Discussion :

[lafafmentvotre]

Bonjour

J'utilise ce code pour afficher les doublons de grosses listes Excel.

J'aimerais le modifier afin que les valeurs des cellules dans la colonne I passent à 1 lorsqu'un doublon est détecté.

Est ce possible ?

Merci par avance pour votre aide

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
Option Explicit
Sub Affich_Doublons_I()
Dim plage As Range
Dim Cel As Range
Dim L As Integer, lig As Integer, col As Integer, i As Byte
 
Application.ScreenUpdating = False
L = ActiveSheet.Range("A10000").End(xlUp).Row
 
Set plage = ActiveSheet.Range("A2:A" & L)
For Each Cel In plage
lig = Cel.Row - 1
col = 8
If Application.CountIf(ActiveSheet.Range("A2:A" & lig), Cel) > 0 Then Cel.Interior.ColorIndex = 6
Next Cel
Application.GoTo Reference:="R2C1"
Application.ScreenUpdating = True
End Sub

[casefayere]

Bonjour le forum, lafafmentvotre,

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
Option Explicit
Sub Affich_Doublons_I()
Dim plage As Range
Dim Cel As Range
Dim L As Integer, lig As Integer, col As Integer, i As Byte
 
Application.ScreenUpdating = False
L = ActiveSheet.Range("A10000").End(xlUp).Row
 
Set plage = ActiveSheet.Range("A2:A" & L)
For Each Cel In plage
lig = Cel.Row - 1
col = 8
If Application.CountIf(ActiveSheet.Range("A2:A" & lig), Cel) > 0 Then Cel.Interior.ColorIndex = 6
cel.offset(0,9) = 1 'regardes et vérifies cette ligne
Next Cel
Application.GoTo Reference:="R2C1"
Application.ScreenUpdating = True
End Sub

[lafafmentvotre]

Hello

Voilà le script que j'avais récupéré (il fonctionne) et modifié :

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
Option Explicit
Sub ColorerDoublons()
Dim plage As Range
Dim Cel As Range
Dim L As Integer, lig As Integer, i As Byte
 
Application.ScreenUpdating = False
L = Sheets("Exemple").Range("B10000").End(xlUp).Row
'Coloration des doublons
Set plage = Sheets("Exemple").Range("B11:B" & L)
For Each Cel In plage
lig = Cel.Row - 1
If Application.CountIf(Sheets("Exemple").Range("B10:B" & lig), Cel) > 0 Then Cel.Interior.ColorIndex = 6
Next Cel
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Ais-je mal modifié le code en sachant que mes valeurs commencent en A2 (la ligne 1 comportant les libellés de colonnes).

Merci pour l'aide

[laetitia]

bonjour le fil le forum les doublons sont senses etre sur la colonne a??? ta boucle par sur la colonne b!!!

[lafafmentvotre]

Hello

Le premier code est celui que j'ai modifié pour utiliser sur la colonne A.
Le second code est celui que j'ai récupéré pour utiliser la colonne B.

C'est le code A qui ne fonctionne pas.

Merci par avance pour le coup de main.

[laetitia]

re ce type de code ne repere pas les doublons tu compare seulement avec la cellule dessus je te propose un code recherche les doublons sur la colonne a passe en jaune plus 1sur la colonne i
par contre si tu veus traiter des lignes de doublons il faut adapter differament

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub essai()
 Dim c As Range, M As Object, L As Long
  Application.ScreenUpdating = False
  Set M = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2:a" & Range("a65536").End(xlUp).Row)
  L = c
  If Not M.Exists(L) Then
  M.Add L, L
  Else
  c.Interior.ColorIndex = 6: c.Offset(0, 8) = 1
  End If: Next c
 End Sub