FAQ ExcelConsultez toutes les FAQ

Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 14 octobre 2009 

 
OuvrirSommaireLes doublons

Cet exemple supprime la ligne complète si des cellules de la plage A1:A10 sont en doublons:

Vba
Sélectionnez

Option Explicit
Option Base 1
 
Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
 
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = Worksheets("Feuil1").Range("A1:A10")
 
    On Error Resume Next
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        'Création d'une collection de données uniques (sans doublons)
        Un.Add Cell, CStr(Cell)
 
        'Une erreur survient si l'élément existe dans la collection.
        'La procédure enregistre le numéro de ligne correspondant dans un tableau.
        If Err.Number <> 0 Then
            x = x + 1
            ReDim Preserve Tableau(1 To x)
            Tableau(x) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
 
    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then Exit Sub
 
    'Fige l'écran pendant la suppression des lignes
    Application.ScreenUpdating = False
 
    'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
        Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete
    Next x
 
    Application.ScreenUpdating = True
End Sub




Ce deuxième code supprime les lignes qui ont le même contenu dans la colonne A.
On suppose que la feuille est préalablement triée sur cette colonne et qu'il n'y a pas de cellule vide dans la colonne A.

Vba
Sélectionnez

Sub DeleteDouble()
  Dim rRange As Range
  Dim rCell As Range
 
  Set rRange = Range([A1], [A1].End(xlDown))
 
  For Each rCell In rRange
    Do While rCell = rCell.Offset(1, 0)
      rCell.Offset(1, 0).EntireRow.Delete
    Loop
  Next rCell
End Sub



Si un problème de casse (majuscules/minuscules) risque de se présenter, ajoutez le mot clé Option Compare Text en tête de module.



Consultez le tutoriel sur les doublons pour obtenir plus d'informations.

Mis à jour le 19 février 2009  par SilkyRoad, Singular, AlainTech, Ouskelnor

Si par exemple vos données sont en A2:A20, saisissez la formule suivante en B2:
=SI(NB.SI($A$2:$A$20;A2)>1;"Multiple";"Unique")

Etirez la formule vers le bas, jusqu'en B20.

Appliquez un filtre automatique dans la feuille et affichez les données contenant la donnée "Multiple".
Copiez les cellules visibles (les doublons) dans une autre feuille.

Créé le 26 mai 2008  par SilkyRoad

La procédure suivante crée une série de nombres entre 1 et 25, de façon aléatoire et sans doublon.
Les valeurs sont écrites verticalement dans la feuille de calcul, et une option permet d'indiquer à partir de quelle cellule (B1 dans l'exemple).

Vba
Sélectionnez

Sub Test()
    GenereSerieAleatoireSansDoublons 25, Range("B1")
End Sub
 
 
Sub GenereSerieAleatoireSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim i As Integer, k As Integer
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next
 
    'Initialise le générateur de nombres aléatoires
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        Cells(Cell.Row + i - 1, Cell.Column) = Tableau(TabNumLignes(k))
        TabNumLignes(k) = TabNumLignes(i)
    Next
 
End Sub




Il est aussi possible d'effectuer le tirage sans macro:

Insérez la formule = Alea() dans la cellule A1, puis utilisez les poignées de recopie jusqu'en A25.
Saisissez les nombres 1 à 25 chronologiquement dans la plage B1:B25
Dans la cellule C1 vous saisissez:
=RECHERCHEV(PETITE.VALEUR($A$1:$A$25;LIGNE());$A$1:$B$25;2;0)
puis utilisez les poignées de recopie jusqu'en C25.

Utilisez la touche clavier F9 pour lancer nouveau tirage.

Créé le 14 mai 2007  par SilkyRoad

Voici une méthode pour dé-doublonner une plage qui utilise un SQL par DAO.
Cette méthode permet de combiner plusieurs champs non contigus pour enlever les doublons.

Pensez à ajouter la référence DAO 3.x.

Vba
Sélectionnez

Sub DAOdedoublonnage()
'lancer le processus de dédoublonnage
Dim rT As Range, rD As Range, rCible As Range
Dim sql As String, group As String
 
On Error GoTo sortiePropre
 
Set rT = application.InputBox("Sélection de la table sans les libellés", _
                    "Dédoublonnage", Selection.AddressLocal, Type:=8)
 
Set rD = application.InputBox("Sélection du/des champs critère(s)", _
                    "Dédoublonnage", Selection.AddressLocal, Type:=8)
 
Set rCible = application.InputBox("Indication de la plage de restitution", _
                    "Dédoublonnage", Selection.AddressLocal, Type:=8)
 
Dim db As DAO.database
Dim rs As DAO.Recordset
 
Set db = DAO.OpenDatabase(rT.Parent.Parent.FullName, False, False, "Excel 8.0;HDR=NO;")
 
For i = 0 To rT.Columns.Count - 1
    If Intersect(rD, rT.Parent.Cells(rT.Row, rT.Column + i)) Is Nothing Then
        sql = sql & ", First([F" & i + 1 & "])"
    Else
        sql = sql & ", [F" & i + 1 & "]"
        group = group & ", [F" & i + 1 & "]"
    End If
Next i
sql = "SELECT " & Mid(sql, 3) & " " & _
        "FROM [" & rT.Parent.Name & "$" & rT.Address(False, False, xlA1) & "] " & _
        "GROUP BY " & Mid(group, 3)
'Debug.Print sql
Set rs = db.OpenRecordset(sql, DAO.dbOpenSnapshot)
rCible.CopyFromRecordset rs
rs.Close
 
sortiePropre:
Set rD = Nothing
Set rT = Nothing
Set rCible = Nothing
Set db = Nothing
Set rs = Nothing
 
End Sub
Créé le 26 mai 2008  par Cafeine

Les données sont par exemple dans la plage A2:B20 et vous souhaitez extraire les éléments de la plage A2:A20 qui n'apparaissent pas dans la plage B2:B20.

Vous allez saisir la formule suivante en C2 :

Formule
Sélectionnez

=SI(A2="";"";SI(NB.SI(B$2:B20;A2)>0;"";MAX($D$1:$D1)+1))



Puis utilisez les poignées de recopie vers le bas, jusqu'en C20.

Vous allez ainsi identifier et indexer les lignes qui contiennent des données répondant à votre recherche.


Nota:
SI(A2="";"";
permet de gérer les éventuelles cellules vides dans la colonne A.


Ensuite saisissez cette formule en D2 :

Formule
Sélectionnez

=SI(LIGNES($C$2:$C2)>MAX($C$2:$C$20);"";DECALER($A$2;EQUIV(LIGNES($C$2:$C2);$C$2:$C$20;0)-1;0))



Puis utilisez les poignées de recopie vers le bas jusqu'en D20.

Vous obtenez la liste synthétique des éléments de la colonne A.
La colonne C ne servant que de calcul intermédiaire, elle pourra éventuellement par la suite être masquée dans la feuille de calcul (Sélectionnez la colonne C / Clic droit / Choisissez l'option "Masquer").

Créé le 18 novembre 2008  par SilkyRoad
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2009 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.