VBA compare de doublons dans une autre colonne

Version imprimable

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:

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

Bonjour,

Une solution possible :
Code:

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,

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

Code:

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.

Réponse

Citation:
Envoyé par Eric KERGRESSE
Bonjour,

Une solution possible :
Code:

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

01/08/2016, 20h06
Invité

Citation:

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.
01/08/2016, 20h37
gFZT82

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 :mrgreen:.

Cordialement.
02/08/2016, 14h36
UARG25

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
02/08/2016, 15h15
UARG25

1 pièce(s) jointe(s)

Bonjour Eric

Ci-joint le dossier , pas de soucis il n'y a pas de choses confidentielles.
Pièce jointe 217024
Encore merci pour tout
Manu
02/08/2016, 15h34
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
02/08/2016, 17h24
Invité

Citation:

Envoyé par UARG25

Bonjour,

Quel est le mot de passe VBA Project ?

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

Cordialement.
02/08/2016, 19h07
UARG25

Bonsoir Eric

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

Manu

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:

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.

08/08/2016, 09h56
UARG25

Bonjour Eric

Mille mercis c'est top ça fonctionne parfaitement !!!
Quand on est Pro on est PRO !!! :D
09/08/2016, 10h27
UARG25

Citation:

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
09/08/2016, 11h31
RyuAutodidacte

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