Discussion :

[facteur]

Bonjour,
J'ai un petit code Vba qui me permet d'identifier des cellule en doublons.
La cellule à gauche de la cellule en doublon devient rouge.
Je souhaiterais insérer dans cette cellule rouge, le contenu de la cellule à gauche de la cellule en doublon.
Je vous joins une image de ce que je souhaiterais faire.
Voici ci dessous mon code vba

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
Sub Doublon()
 
    Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("Feuil1")
 
       Set Plage = .Range(.Cells(3, 3), .Cells(.Rows.Count, 6).End(xlUp))
 
    End With
 
 
     For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
        Cel.Offset(0, -2).Interior.ColorIndex = 3
 
        End If
 
    Next Cel
 
End Sub

Voici l'image

Je souhaiterais, inserer dans les cellules rouges, le numéro à gauche du prénom en doublon
ex :
A gauche de la cellule 001, j'aurais 036 qui correspond au numéro du doublon Pierre
A gauche de la cellule 036, j'aurais 001 qui correspond au numéro du doublon Pierre

A gauche de la cellule 003, j'aurais 038 qui correspond au numéro du doublon Rachel
A gauche de la cellule 038, j'aurais 003 qui correspond au numéro du doublon Rachel

Etc....

Est ce possible ?

Merci d'avance

[Invité]

Bonjour,

Une solution possible :

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
 
Sub Doublon()
 
Dim Plage1 As Range, Plage2 As Range
 
    With Worksheets("Feuil1")
 
         Set Plage1 = .Range(.Cells(3, 3), .Cells(.Rows.Count, 3).End(xlUp))
         Set Plage2 = .Range(.Cells(3, 6), .Cells(.Rows.Count, 6).End(xlUp))
 
         ChercherLesDoublonsDansDeuxPlages Plage1, Plage2
         ChercherLesDoublonsDansDeuxPlages Plage2, Plage1
 
         Set Plage1 = Nothing
         Set Plage2 = Nothing
 
    End With
 
End Sub
 
Sub ChercherLesDoublonsDansDeuxPlages(ByVal MaPlage1 As Range, ByVal MaPlage2 As Range)
 
Dim Cel1 As Range, Cel2 As Range
 
         For Each Cel1 In MaPlage1
             For Each Cel2 In MaPlage2
                 If Cel1 = Cel2 Then
                    With Cel1.Offset(0, -2)
                         .Value = Cel2.Offset(0, -1)
                         .Interior.ColorIndex = 3
                         .Font.Color = RGB(255, 255, 255)
                    End With
                End If
             Next Cel2
         Next Cel1
 
End Sub

[Menhir]

Je souhaiterais, inserer dans les cellules rouges, le numéro à gauche du prénom en doublon

Pourquoi utiliser une macro alors qu'une combinaison de EQUIV() et INDEX() peut faire ça très simplement ?
Avec une petite SIERREUR() pour englober tout ça et afficher un vide plutôt qu'un message d'erreur.

En supposant que te première liste est en B1:C10 et que ta seconde liste est en E1:F10,
met en A1 la formule :

Code :

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

=SIERREUR(INDEX(E$1:E$10;EQUIV(C1;F$1:F$10;0)))

Copier A1 vers le bas autant que nécessaire.

Et pour la mise en rouge de la cellule, une petite mise en forme conditionnelle (valeur différente de vide) fera ça en quelques secondes.