S.o.s. Doublons

[birdy1948]

Bonjour à tous,

Sur la feuille 1 d'un classeur, j'ai une base de données avec noms, adresses et autres références.

Sur la feuille 2, une autre base de données avec noms, adresses etc...

Idem sur la feuille 3

Mais, je retrouve sur 2 feuilles (voire 3) quelques noms et adresses identiques.

je voudrais pouvoir automatiser la recherche afin de supprimer les doublons ; pouvez-vous m'aider ? c'est un travail urgent et je n'ai guère le temps de faire des recherches !

merci par avance

birdy 1948

 

[Hellboy]

Re : S.o.s. Doublons

Bonjour

Quelques adresse identique a la feuille 1 ?
Quel est la feuille de référence ?

 

[birdy1948]

Re : S.o.s. Doublons

Bonjour, merci pour ta rapidité !
en fait j'ai 3 bases de données sur 3 feuilles différentes ; je dois faire un mailing aux personnes des 3 bases, mais je retrouve sur les feuilles 2 et 3 des noms et adresses identiques ; je veux donc supprimer ces doublons en feuilles 2 et 3 afin de ne leur écrire qu'une seule fois
merci de ton aide
birdy1948

 

[Hellboy]

Re : S.o.s. Doublons

re

Une dernière question, avant de te proposer un soluce. Qui doit concerver les nom unique ? La feuille 2 ou 3.

Aussi, je dois savoir ou se retrouve l'information ds tes feuilles. Comment est disposé tes champs dans ta base de données.

a+

 

[Gorfael]

Re : S.o.s. Doublons

Bonjour, merci pour ta rapidité !
en fait j'ai 3 bases de données sur 3 feuilles différentes ; je dois faire un mailing aux personnes des 3 bases, mais je retrouve sur les feuilles 2 et 3 des noms et adresses identiques ; je veux donc supprimer ces doublons en feuilles 2 et 3 afin de ne leur écrire qu'une seule fois
merci de ton aide
birdy1948

salut
Un peu plus d'infos seraient les bienvenues :
les feuiilles sont-elles identiques quand aux colonnes Noms et adresses ?
Colonnes concernées ?
Que 3 feuilles dans le classeurs ? Si plus, comment les identifier ?
Si tu as fait des feuilles séparées, ça doit répondre à un besoin. Donc supprimer une adresse peut avoir des conséquences.
Comment on supprime ? Quelle feuille est prioritaire sur les autres ?

Plutôt que de supprimer, recopier les noms et adresses sur une feuille de synthèse ne serait pas mieux ?

Une copie de ton fichier avec 1 ou 2 nom+adresse bidon serait plus facile à traiter
A+

 

[birdy1948]

Re : S.o.s. Doublons

Merci de votre intéret ! alors voila un peu plus de détails :
1. la ligne d'étiquette est la même sur les 3 feuilles.

2. Il s'agit d'une liste de stagiaires ; par exemple :
feuille 1 = liste de stagiaires ayant suivi une initiation Informatique
feuille 2 = liste de stagiaires ayant suivi une initiation Word
feuille 3 = liste de stagiaires ayant suivi une initiation Internet.

Or, dans certains cas, les coordonnées d'un stagiaire se retrouve sur les 3 feuilles, car il a suivi les 3 formations ; mais un stagiaire peut également se retrouver sur une seule liste car il n'a suivi qu'une seule formation

L'idéal serait bien sur de pouvoir regrouper tout ce beau monde une seule fois sur une feuille 4 par exemple ! mais voilà ... est-ce possible ?
merci d'avance pour vos lumières !!

 

[Hellboy]

Re : S.o.s. Doublons

re

Même si elles sont pareil les étiquettes, ça parrait pas comme ça là, mais ça aide quand même de savoir comment elles sont disposé. Exemple:

Colonne A Colonne B
Prénom Nom

ou

Colonne A
Nom et prénom

a+

 

[birdy1948]

Re : S.o.s. Doublons

Bonjour,

voici un modèle de mon fichier :

Feuille 1 :

Col A B C D E F
NOM PRENOM ADRESSE CP VILLE N° TEL
DUPONT Marc 8 rue... 66... XXX 00 00 00 00 00
DURANT Josée 6 blvd... 66... XXX 00 22 11 55 99
PELOS Jean 5 rue.... 66... XXX 00 44 88 77 33


Feuille 2 :

Col A B C D E F
NOM PRENOM ADRESSE CP VILLE N° TEL
MARTIN Lucie 52 rue... 66... XXX 11 22 55 33 29
DURANT Josée 6 blvd... 66... XXX 00 22 11 55 99
ALLUN Joël Le Mas 66... XXX 66 33 22 11 00


(Même principe sur la feuille 3)
je voudrais sur une nouvelle feuille faire une nouvelle base mais qui ne ferait apparaitre DURANT Josée qu'une seule fois - merci de ton aide et bonne journée

 

[Gorfael]

Re : S.o.s. Doublons

Bonjour,

voici un modèle de mon fichier :

Feuille 1 :

Col A B C D E F
NOM PRENOM ADRESSE CP VILLE N° TEL
DUPONT Marc 8 rue... 66... XXX 00 00 00 00 00
DURANT Josée 6 blvd... 66... XXX 00 22 11 55 99
PELOS Jean 5 rue.... 66... XXX 00 44 88 77 33


Feuille 2 :

Col A B C D E F
NOM PRENOM ADRESSE CP VILLE N° TEL
MARTIN Lucie 52 rue... 66... XXX 11 22 55 33 29
DURANT Josée 6 blvd... 66... XXX 00 22 11 55 99
ALLUN Joël Le Mas 66... XXX 66 33 22 11 00


(Même principe sur la feuille 3)
je voudrais sur une nouvelle feuille faire une nouvelle base mais qui ne ferait apparaitre DURANT Josée qu'une seule fois - merci de ton aide et bonne journée

Salut
Tu crées une feuille que tu nommes : Récap
en ligne 1 tu copies ta ligne de titre (nom, prénom,....)

Menu Outils>>Macro>>nouvelle macro
Tu valides par ok
tu arrêtes l'enregistrement à l'aide de la barre d'outils qui apparaît

Menu Outils>>Macro>>Macro>>modifier
entre Sub nom_macro() et end sub, tu copies le code qui suit

Dim X As Long
Dim Y As Byte
Dim Flag_Suppr As Boolean

Sheets("Récap").Select
If Range("A65536").End(xlUp).Row > 1 Then
    Range("A2:F" & Range("A65536").End(xlUp).Row).ClearContents
End If
For X = 1 To Sheets.Count
    If Sheets(X).Name <> "Récap" Then
        Sheets(X).Select
        Range("A2:F" & Range("A65536").End(xlUp).Row).Copy
        Sheets("Récap").Activate
        Range("A" & (Range("A65536").End(xlUp).Row + 1)).Activate
        ActiveSheet.Paste
    End If
Next X
'on trie
Columns("A:F").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1
Flag_Suppr = False
For X = Range("A65536").End(xlUp).Row To 2 Step -1
    If Cells(X, 1) = Cells(X - 1, 1) Then
        Flag_Suppr = True
        For Y = 1 To 3
            If Cells(X, 1).Offset(0, Y) <> Cells(X - 1, 1).Offset(0, Y) Then Flag_Suppr = False
        Next
        If Flag_Suppr = True Then
            Rows(X).Delete
            Flag_Suppr = False
        End If
    End If
Next X

ensuite, tu l'exécutes
la macro :
- copie les infos de chaque feuille sur la feuille "Récap" (col A à F)
- trie la feuille en fonction de nom/prénom/adresse
ensuite elle compare chaque ligne à la précédente
si le nom est identique, on compare prénom, adresse, CP
si c'est identique on efface la ligne

A+

 

[birdy1948]

Re : S.o.s. Doublons

Merci beaucoup pour ton travail ; mais il y a un probleme : quand je lance la macro, j'ai le message suivant :
ERREUR D'EXECUTION "9"
L'INDICE N'APPARTIENT PAS A LA SELECTION

pour moi, c'est du chinois !

désolée de t'ennuyer encore !

 

[Gorfael]

Re : S.o.s. Doublons

Merci beaucoup pour ton travail ; mais il y a un probleme : quand je lance la macro, j'ai le message suivant :
ERREUR D'EXECUTION "9"
L'INDICE N'APPARTIENT PAS A LA SELECTION

pour moi, c'est du chinois !

désolée de t'ennuyer encore !

Salut
Tu peux copier ta macro sur un post SVP
A+

 

[birdy1948]

Re : S.o.s. Doublons

Voici la macro entrée :
Sub Macro1()
'Dim X As Long
Dim Y As Byte
Dim Flag_Suppr As Boolean

Sheets("Récap").Select
If Range("A65536").End(xlUp).Row > 1 Then
Range("A2:F" & Range("A65536").End(xlUp).Row).ClearContents
End If
For X = 1 To Sheets.Count
If Sheets(X).Name <> "Récap" Then
Sheets(X).Select
Range("A2:F" & Range("A65536").End(xlUp).Row).Copy
Sheets("Récap").Activate
Range("A" & (Range("A65536").End(xlUp).Row + 1)).Activate
ActiveSheet.Paste
End If
Next X
'on trie
Columns("A:F").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1
Flag_Suppr = False
For X = Range("A65536").End(xlUp).Row To 2 Step -1
If Cells(X, 1) = Cells(X - 1, 1) Then
Flag_Suppr = True
For Y = 1 To 3
If Cells(X, 1).Offset(0, Y) <> Cells(X - 1, 1).Offset(0, Y) Then Flag_Suppr = False
Next
If Flag_Suppr = True Then
Rows(X).Delete
Flag_Suppr = False
End If
End If
Next X

' Macro1 Macro
' Macro enregistrée le 27/07/2006 par PAPA
'

'
End Sub

 

[Gorfael]

Re : S.o.s. Doublons

Salut birdy1948

Sub Macro1 ()
Dim X As Long '************************************
Dim Y As Byte
Dim Flag_Suppr As Boolean

Sheets("Récap").Select
If Range("A65536").End(xlUp).Row > 1 Then
Range("A2:F" & Range("A65536").End(xlUp).Row).ClearContents
End If

For X = 1 To Sheets.Count
If Sheets(X).Name <> "Récap" Then
Sheets(X).Select
Range("A2:F" & Range("A65536").End(xlUp).Row).Copy
Sheets("Récap").Activate
Range("A" & (Range("A65536").End(xlUp).Row + 1)).select '*************
ActiveSheet.Paste
End If
Next X
'on trie
Columns("A:F").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1
Flag_Suppr = False
For X = Range("A65536").End(xlUp).Row To 2 Step -1
If Cells(X, 1) = Cells(X - 1, 1) Then
Flag_Suppr = True
For Y = 1 To 3
If Cells(X, 1).Offset(0, Y) <> Cells(X - 1, 1).Offset(0, Y) Then Flag_Suppr = False
Next
If Flag_Suppr = True Then
Rows(X).Delete
Flag_Suppr = False
End If
End If
Next X

' Macro1 Macro
' Macro enregistrée le 27/07/2006 par PAPA
'

'
End Sub

'********** : lignes à modifier
en gros, si tu vas voir la feuille récap, elle doit être remplie jusqu'à la dernière ligne : En début, si les lignes sont vides, il sélectionne tout le tableau. ça, c'est pas grave. Mais j'ai oublié la différence entre activate et select.
tu ne peux activer qu'une cellule, mais ça ne fait pas changer ta sélection. Par contre quand tu copies, tu copies sur toute ta sélection (oups!)

Donc tu vas sur la feuille récap et tu effaces les 3 dernières lignes. Après tu pourra lancer ta macro
A+

 

[Hellboy]

Re : S.o.s. Doublons

Bonjour a tous

Ca été plus long que prévue, mais voici quand même:

Option Explicit

Public Sub No_Doublon()
Dim intLastRow As Integer, intNbAreaX As Integer, intLigneFallow As Integer, intItemIn As Integer, intLine As Integer

Dim bytLoop As Byte, bytIndex As Byte
  
Dim strFullName As String

Worksheets.Add after:=Worksheets(3)
ActiveSheet.Name = "New"
Worksheets(1).Activate
' Cette boucle sert a comparer chaque combinaison(3) de feuille
For bytLoop = 1 To 3
  Select Case bytLoop
     ' Compare les noms de la feuille 1 avec la feuille 2
      Case 1
        Worksheets(bytLoop + 1).Activate
        bytIndex = bytLoop
        ActiveSheet.Cells(1, 1).AutoFilter
     ' Compare les noms de la feuille 1 avec la feuille 3
      Case 2
        Worksheets(bytLoop + 1).Activate
        bytIndex = bytLoop - 1
        ActiveSheet.Cells(1, 1).AutoFilter
     ' Compare les noms de la feuille 2 avec la feuille 3
      Case 3
        bytIndex = bytLoop - 1
  End Select
  intLastRow = Worksheets(bytIndex).Cells.SpecialCells(xlLastCell).Row
 
 ' Boucle sur chaque ligne de la feuille de référence
  For intLine = 2 To intLastRow Step 1
    With Worksheets(bytIndex)
       strFullName = .Cells(intLine, 1) & " " & .Cells(intLine, 2)
       Cells(1, 1).AutoFilter Field:=1, Criteria1:="" & .Cells(intLine, 1)
    End With
    If Not strFullName = " " Then
      Range(Cells(2, 1), Cells(Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row, Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column)).Select
      If Selection.Height <> 0 Then
        Selection.SpecialCells(xlCellTypeVisible).Select
        With Selection.Areas
          For intNbAreaX = 1 To .Count
            intLigneFallow = .Item(intNbAreaX).Row - 1
            For intItemIn = 1 To .Item(intNbAreaX).Count - 1
              If strFullName = (Cells(intLigneFallow + intItemIn, 1) & " " & Cells(intLigneFallow + intItemIn, 2)) Then
                With Rows(intLigneFallow + intItemIn)
                  .Copy Destination:=Worksheets("New").Cells(Worksheets("New").Cells(65000, 1).End(xlUp).Row + 1, 1)
                  .Clear
               End With
              End If
             Next intItemIn
           Next intNbAreaX
        End With
      End If
    End If
  Next intLine
Next bytLoop

' Copie l'ensemble des nom qui sont rester sur les feuille 1 2 et 3 sur la feuille 4
For bytLoop = 1 To 3
  With Worksheets(bytLoop)
    .Activate
     intLastRow = .Cells.SpecialCells(xlLastCell).Row
  End With
  For intLine = 2 To intLastRow Step 1
    If Not Cells(intLine, 1) = Empty Then
      Rows(intLine).Copy Destination:=Worksheets("New").Cells(Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 1, 1)
    End If
  Next intLine
Next bytLoop
End Sub

 

[Hellboy]

Re : S.o.s. Doublons

Bonjour a tous

Ca été plus long que prévue, mais voici quand même:

Option Explicit

Public Sub No_Doublon()
Dim intLastRow As Integer, intNbAreaX As Integer, intLigneFallow As Integer, intItemIn As Integer, intLine As Integer

Dim bytLoop As Byte, bytIndex As Byte
  
Dim strFullName As String

Worksheets.Add after:=Worksheets(3)
ActiveSheet.Name = "New"
Worksheets(1).Activate
' Cette boucle sert a comparer chaque combinaison(3) de feuille
For bytLoop = 1 To 3
  Select Case bytLoop
     ' Compare les noms de la feuille 1 avec la feuille 2
      Case 1
        Worksheets(bytLoop + 1).Activate
        bytIndex = bytLoop
        ActiveSheet.Cells(1, 1).AutoFilter
     ' Compare les noms de la feuille 1 avec la feuille 3
      Case 2
        Worksheets(bytLoop + 1).Activate
        bytIndex = bytLoop - 1
        ActiveSheet.Cells(1, 1).AutoFilter
     ' Compare les noms de la feuille 2 avec la feuille 3
      Case 3
        bytIndex = bytLoop - 1
  End Select
  intLastRow = Worksheets(bytIndex).Cells.SpecialCells(xlLastCell).Row
 
 ' Boucle sur chaque ligne de la feuille de référence
  For intLine = 2 To intLastRow Step 1
    With Worksheets(bytIndex)
       strFullName = .Cells(intLine, 1) & " " & .Cells(intLine, 2)
       Cells(1, 1).AutoFilter Field:=1, Criteria1:="" & .Cells(intLine, 1)
    End With
    If Not strFullName = " " Then
      Range(Cells(2, 1), Cells(Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row, Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column)).Select
      If Selection.Height <> 0 Then
        Selection.SpecialCells(xlCellTypeVisible).Select
        With Selection.Areas
          For intNbAreaX = 1 To .Count
            intLigneFallow = .Item(intNbAreaX).Row - 1
            For intItemIn = 1 To .Item(intNbAreaX).Count - 1
              If strFullName = (Cells(intLigneFallow + intItemIn, 1) & " " & Cells(intLigneFallow + intItemIn, 2)) Then
                With Rows(intLigneFallow + intItemIn)
                  .Copy Destination:=Worksheets("New").Cells(Worksheets("New").Cells(65000, 1).End(xlUp).Row + 1, 1)
                  .Clear
               End With
              End If
             Next intItemIn
           Next intNbAreaX
        End With
      End If
    End If
  Next intLine
Next bytLoop

' Copie l'ensemble des nom qui sont rester sur les feuille 1 2 et 3 sur la feuille 4
For bytLoop = 1 To 3
  With Worksheets(bytLoop)
    .Activate
     intLastRow = .Cells.SpecialCells(xlLastCell).Row
  End With
  For intLine = 2 To intLastRow Step 1
    If Not Cells(intLine, 1) = Empty Then
      Rows(intLine).Copy Destination:=Worksheets("New").Cells(Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row + 1, 1)
    End If
  Next intLine
Next bytLoop
End Sub