Discussion :

[mammmy]

Salut,
J'ai un petit souci. Etant débutant dans VB, il devient grand souci
Je cherche à comparer les cellules de la colonne N dans le même fichier excel pour ensuite supprimer les doublons.
Est ce que quelqu'un peut m'aider?
Merci

[mayekeul]

bonjour,

un exemple de comment je procederai

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
    Range("A1:A20").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True

[mammmy]

Merci Mayekeul,
Mais est ce que tu peux m'expliquer que fait ce code?
Merci

[mayekeul]

c'est très simple, sur base d'une liste, il va extraire les records uniques et les copier à une place donnée.

un pti coup de F1

[mammmy]

Merci, j'ai compris.
Mais si je fais ça, il va me donner que les uniques et moi je veux qu'il compare les cellules de la colonne et puis qu'il me supprime la ligne de la cellule qui est en double et qu'il me laisse celle qui a détecté en premier. Cad si par exemple, il trouve le même nom 2 fois dans la même colonne, il doit me supprimer qu'un seul et me laisser l'autre.

[mayekeul]

ben oui!

[mammmy]

Alors comment faire? (je veux qu'il compare les cellules de la colonne et puis qu'il me supprime la ligne de la cellule qui est en double et qu'il me laisse celle qui a détecté en premier. Cad si par exemple, il trouve le même nom 2 fois dans la même colonne, il doit me supprimer qu'un seul et me laisser l'autre)
Est ce que quelqu'un peux m'aider?
Merci

[mayekeul]

bon allez!

une fois que tu a copieé la liste dans l'exemple précedent, tu fait comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
' et puis non, on va faire depuis le début
dim lis  as string,lscount as integer
dim rng as range,C as range
 
'la liste à comparer
set rng=range("A1:A20")
'on filtre et copie
rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
'on récupere les éléments unique
lis=range(cells(1,3),cells1,3).end(xldown)
 
for each c in rng
    for each l in lis
        if c.value=l then lscount=1
        if lscount then c=""
    next l
    lscount=0
next c
rngCells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[mammmy]

Mais moi, je ne veux pas filtrer puis copier.
Est ce que mon but n'est pas clair?

[mayekeul]

bon allez

bien que je ne trouve pas que ce soit une bonne solution

essaye ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 Macro2()
Dim LIS()  As String, lsCount() As Integer
Dim RNG As Range, C As Range, VExist As Boolean
Dim I, J, L
 
'la liste à comparer
Set RNG = Range("A1:A20")
 
For Each C In RNG
    ReDim Preserve LIS(I)
    For J = 0 To I
        If LIS(J) = C.Value Then VExist = True
    Next J
    If Not VExist Then
        LIS(I) = C.Value
        I = I + 1
    End If
    VExist = False
Next C
 
ReDim lsCount(UBound(LIS))
 
 
For I = 0 To UBound(LIS)
    lsCount(I) = -1
    For Each C In RNG
        Debug.Print C & ";" & L
        If C.Value = LIS(I) Then lsCount(I) = lsCount(I) + 1
        If C.Value = LIS(I) And lsCount(I) Then C.Value = ""
    Next C
Next I
RNG.Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
End Sub