Trouver les doublons sur Excel

Trouver les doublons sur Excel - VB/VBA/VBS - Programmation

Marsh Posté le 28-08-2009 à 14:46:30    

Bonjour,
 
Je suis en train de reprendre une tres grosse base de donnee Excel avec plusieurs colonnes (nom, adresse, Code postal, N° Tel, adresse Mail, etc...)
le probleme pour moi, c'est qu'il y a pas mal de doublons et je souhaiterais pouvoir les retrouver facilement avec des couleurs.
 
Pour se faire j'ai trouve une solution avec l'ajout d'une macro en VBA qui marche tres bien pour les noms, adresse et N° de tel mais par contre pour les adresses mail, elle ne fonctionne pas  :??:  
 
voici ma macro :

Citation :


Type TableauType
  Contenu As String
  Coordonnee As Integer
End Type
 
Sub TrouveDoublon()
  Dim Tableau() As TableauType
  Dim Cellule, Haut, Bas, Compteur, C2
  Colonne = ActiveCell.Column
  Haut = Selection.End(xlUp).Row
  Bas = Selection.End(xlDown).Row
  ReDim Tableau(Bas)
  For Compteur = Haut To Bas
    Tableau(Compteur).Contenu = Cells(Compteur, Colonne)
    Tableau(Compteur).Coordonnee = Cells(Compteur, Colonne).Row
  Next
  For Compteur = Haut To Bas
    For C2 = (Compteur + 1) To Bas
      If Tableau(Compteur).Contenu = Tableau(C2).Contenu Then
        Cells(Tableau(Compteur).Coordonnee, Colonne).Interior.ColorIndex = 4
        Cells(Tableau(C2).Coordonnee, Colonne).Interior.ColorIndex = 3
      End If
    Next
  Next
End Sub


 
Est ce qu'une ame charitable pourrais m'aider ???
 
Merci par avance pour vos reponses....
PS : je n'y connais rien en VB !!

Reply

Marsh Posté le 28-08-2009 à 14:46:30   

Reply

Marsh Posté le 28-08-2009 à 14:55:40    

Ce sujet a été déplacé de la catégorie Windows & Software vers la categorie Programmation par Wolfman

Reply

Marsh Posté le 28-08-2009 à 15:31:26    

Bonjour,
 
 
Normalement elle devrait fonctionner
 
Voici une méthode plus rapide
 

Sub TrouveDoublon()
  Dim colonne, Haut, Bas, cle
  Colonne = ActiveCell.Column
  Haut = Selection.End(xlUp).Row
  Bas = Selection.End(xlDown).Row
  Dim tab1
  Set tab1 = CreateObject("Scripting.dictionary" )
  For Compteur = 3 To 9
    cle = CStr(Cells(Compteur, Colonne))
    If tab1.exists(cle) Then
        couleur = 3
    Else
        tab1(cle) = 1
        couleur = 4
    End If
    Cells(Compteur, Colonne).Interior.ColorIndex = couleur
  Next
End Sub


 

Reply

Marsh Posté le 31-08-2009 à 12:23:15    

Bonjour,
Merci beaucoup pour ton aide, en effet la 1ere fonctionne bien aussi, juste que je dois trier la colonne avant !
 
encore merci a toi Pyrof

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed