VBA compare de doublons dans une autre colonne

**UARG25** · 29/07/2016, 21h30

Bonjour

J'ai un dossier avec des chiffres dans la colonne B via la requête ci-dessous j'insert une colonne en " C" et je compare les valeurs dans la colonne B afin de voir si il n'y a pas de doublons soi oui il m'indique DOUBLE si non il m'indique OK j'y arrive sur une cellule mais je n'arrive pas à le faire sur toutes les cellules de la colonne B

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
Sub Compare()
 
Dim DerCel As String
DerCel = Range("C3").End(xlDown).Address
Columns(3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C3").Select
ActiveCell.FormulaR1C1 = "Double"
Range("C4").Select
 
If Range("B5").Value = Range("B4").Value Then
Range("C5").Value = "Double"
Else
Range("C5").Value = "OK"
End If
 
 
End Sub

Invité · 30/07/2016, 04h56

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
 
Sub Compare_EK()
 
Dim DerniereLigne As Long
 
    With Sheets("Feuil1")  ' A adapter
 
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         .Columns(3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         .Range("C3") = "Double"
         With .Range("C4")
               .FormulaR1C1 = "=IF(R[1]C[-1]=RC[-1],""Double"",""OK"")"
                .AutoFill Destination:=Sheets("Feuil1").Range("C4:C" & DerniereLigne)
         End With
 
    End With
 
End Sub

En utilisant l'enregistreur de macro, vous auriez eu directement la formule à appliquer en C4.

Nb :

- Je teste la dernière ligne à partir du bas dans la première colonne, au cas où il y aurait "des trous dans la raquette", mais ce n'est peut-être pas possible dans votre fichier.
- Vous n'avez pas besoin de sélectionner les cellules, votre code ira plus vite.

Cordialement.

**gFZT82** · 30/07/2016, 10h49

Bonjour,

Un autre type de solution consiste à affecter un format particulier pour repérer les doublons.
Exemple avec un remplissage en rouge :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Compare()
Dim DerLigne As Long, Ligne As Long
    DerLigne = Range("C3").End(xlDown).Row
    For Ligne = DerLigne To 4 Step -1
        If Application.CountIf(Range(Cells(3, 3), Cells(Ligne - 1, 3)), Cells(Ligne, 3).Value) > 0 Then
            Cells(Ligne, 3).Interior.ColorIndex = 3
        Else
            Cells(Ligne, 3).Interior.ColorIndex = xlNone
        End If
    Next
End Sub

Cordialement.

**UARG25** · 01/08/2016, 17h54

Envoyé par Eric KERGRESSE

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
 
Sub Compare_EK()
 
Dim DerniereLigne As Long
 
    With Sheets("Feuil1")  ' A adapter
 
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         .Columns(3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         .Range("C3") = "Double"
         With .Range("C4")
               .FormulaR1C1 = "=IF(R[1]C[-1]=RC[-1],""Double"",""OK"")"
                .AutoFill Destination:=Sheets("Feuil1").Range("C4:C" & DerniereLigne)
         End With
 
    End With
 
End Sub

En utilisant l'enregistreur de macro, vous auriez eu directement la formule à appliquer en C4.

Nb :

- Je teste la dernière ligne à partir du bas dans la première colonne, au cas où il y aurait "des trous dans la raquette", mais ce n'est peut-être pas possible dans votre fichier.
- Vous n'avez pas besoin de sélectionner les cellules, votre code ira plus vite.

Cordialement.

Bonjour Eric

Ca fonctionne parfaitement mais quand j'active la requête à chaque fois sur la ligne : .AutoFill il bug et je suis obliger de passer par DEBOGAGE bien qu'il ai exécuté la requête.
Je profite pour vous demander comment puis je colorer le texte DOUBLE en rouge dans les colonnes.
J'ai fait plusieurs tentatives en vain
Cordialement
Manu

Invité · 01/08/2016, 20h06

Envoyé par UARG25

Ca fonctionne parfaitement mais quand j'active la requête à chaque fois sur la ligne : .AutoFill il bug et je suis obliger de passer par DEBOGAGE bien qu'il ai exécuté la requête.

Bonjour,

Peux-tu mettre un fichier exemple (sans données confidentielles) en ligne avec ton code ?

Cordialement.

**gFZT82** · 01/08/2016, 20h37

Bonjour,

Je cherche à comprendre pourquoi j'ai été snobé.
Option 1 : mon propos est transparent,
Option 2 : mon propos est sans intérêt,
Option 3 : je sens le fuel.

Dans le doute, je vais prendre une douche

.

Cordialement.

**UARG25** · 02/08/2016, 14h36

Bonjour
Pas le moindre votre requête fonctionne mais je n'ai pas d'insertion de colonne comme dans la requête d'Eric par contre dans la requête d'Eric je n'ai pas la coloration du Double
Avec vos aides je vais y arriver
Merci pour tout
Manu

**UARG25** · 02/08/2016, 15h15

Bonjour Eric

Ci-joint le dossier , pas de soucis il n'y a pas de choses confidentielles.
Manu Test 3.xls
Encore merci pour tout
Manu

**RyuAutodidacte** · 02/08/2016, 15h34

Bonjour,
j'avais répondu à un post sur les doublons en utilisant les MFC, peut être que cela pourrait t'intéresser :
Besoin d'aide pour une macro de recherche de doublon

Invité · 02/08/2016, 17h24

Envoyé par UARG25

Bonjour,

Quel est le mot de passe VBA Project ?

Si problème, me l'envoyer par message privé.

Cordialement.

**UARG25** · 02/08/2016, 19h07

Bonsoir Eric

Sorry ! le password est manumanu il n'y a aucun soucis car ce n'est pas du tout confidentiel

Manu

Invité · 02/08/2016, 20h06

Dans ma première version, la dernière ligne du tableau était basée sur la colonne A qui est vide dans ton tableau, cela ne pouvait pas fonctionner.
Dans cette version, la dernière ligne est basée sur la colonne B.

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
 
Sub Compare_EK_V2()
 
Dim LigneTitre As Long
Dim DerniereLigne As Long
Dim AireDoublons As Range
Dim CelluleDoublons As Range
 
    With Sheets("Incidents créés")
 
         LigneTitre = 3
         DerniereLigne = .Cells(.Rows.Count, 2).End(xlUp).Row ' 2 parce que la colonne A est vide
         .Columns(3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
         .Range("C3") = "Double"
         Set AireDoublons = .Range(.Cells(LigneTitre + 1, 3), .Cells(DerniereLigne, 3))
 
         With .Range("C4")
              .FormulaR1C1 = "=IF(R[1]C[-1]=RC[-1],""Double"",""OK"")"
              .AutoFill Destination:=AireDoublons
         End With
 
         For Each CelluleDoublons In AireDoublons
             If CelluleDoublons = "Double" Then
                With CelluleDoublons.Font
                     .Color = RGB(255, 0, 0)
                     .Bold = True
                End With
             End If
         Next CelluleDoublons
 
         Set AireDoublons = Nothing
 
    End With
 
End Sub

Sinon par rapport à la réaction de gFZT82 qui est tout à fait logique, il te faut répondre à tous ceux qui ont pris la peine de plancher sur ton problème. Si un jour, ton expérience aidant, tu réponds également aux demandes, tu seras bien content d'avoir ce signe de reconnaissance et sans doute très frustré si on ne te répond pas.

Bon courage.

Cordialement.

**UARG25** · 08/08/2016, 09h56

Bonjour Eric

Mille mercis c'est top ça fonctionne parfaitement !!!
Quand on est Pro on est PRO !!!

**UARG25** · 09/08/2016, 10h27

Envoyé par RyuAutodidacte

Bonjour,
j'avais répondu à un post sur les doublons en utilisant les MFC, peut être que cela pourrait t'intéresser :
Besoin d'aide pour une macro de recherche de doublon

Merci à vous pour ce petit cours de VBA

Cordialement

**RyuAutodidacte** · 09/08/2016, 11h31

Bonjour,
De rien, le principal c'est que cela puisse aider/faire avancer

VBA compare de doublons dans une autre colonne

Macros et VBA Excel

Discussions similaires

Partager

Partager