Suppréssion de doublons

LordZerty

XLDnaute Nouveau
Bonjour,

J'aurais besoin d'aide afin de créer une fonction permettant de supprimer les doublons dans une colonne.

J'ai un tableau nommer "Tableau_Fraise", dans la colonne 2 de ce tableau je souhaiterais empêcher l'ajout de doublon via le formulaire d'ajout que j'ai créer. Ceci en le testant lors de click sur le bouton "AJOUTER" de mon formulaire.

Hors je ne sais pas comment faire, quelqu'un pourrais m'éclairer ?

Je vous remercie d'avance :)
 

LordZerty

XLDnaute Nouveau
Re : Suppréssion de doublons

J'ai reussi à faire une fonction qui m'indique le doublon ainsi que le nombre de doublon de celui-ci... Hors je ne trouve pas comment supprimer les lignes où ce trouve les doublons :

Code:
rivate Sub B_Test_Click()

' ----------------------------------- TEST ----------------------------------------

    Dim Plage As Range
    Dim Tableau(), Resultat() As String
    Dim i As Integer, j As Integer, m As Integer
    Dim Un As Collection
    Dim Doublons As String
        
    Set Un = New Collection
    'La plage de cellules (sur une colonne) à tester
    Set Plage = Range("Liste:B" & Range("Liste").End(xlUp).Row)
      
      
    Tableau = Plage.Value
    
    On Error Resume Next
    'boucle sur la plage à tester
    For i = 1 To Plage.Count
    
        ReDim Preserve Resultat(2, m + 1)
        
        'Utilise une collection pour rechercher les doublons
        '(les collections n'acceptent que des données uniques)
        Un.Add Tableau(i, 1), CStr(Tableau(i, 1))
        
        'S'il y a une erreur (donc présence d'un doublon)
        If Err <> 0 Then
            
            'boucle sur le tableau des doublons pour vérifier s'il a déjà
            'été identifié
            For j = 1 To m + 1
                'Si oui, on  incrémente le compteur
                If Resultat(1, j) = Tableau(i, 1) Then
                    Resultat(2, j) = Resultat(2, j) + 1
                    Err.Clear
                    Exit For
                End If
            Next j
                
                'Si non, on ajoute le doublon dans le tableau
                If Err <> 0 Then
                    Resultat(1, m + 1) = Tableau(i, 1)
                    Resultat(2, m + 1) = 1
                    
                    m = m + 1
                    Err.Clear

                End If
        End If
    Next i

    '----- Affiche la liste et le nombre de doublons --------
    For j = 1 To m
        Doublons = Doublons & Resultat(1, j) & " --> " & _
                    Resultat(2, j) & vbCrLf
    Next j
    
    MsgBox Doublons
    
    Set Un = Nothing
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 450
Messages
2 088 510
Membres
103 873
dernier inscrit
Sabin