alléger une macro

[klip89]

Bonjour,

je suis sous excel 2000

j'ai une macro pour supprimer les doublons

voici ce qu'elle fait

j'ai par exemple les mots suivants dans une colonne
maman
maman
maman
papa
papa
oui
non
non

Ma macro me supprime tous les mots qui sont présents plus d'une fois donc dans l'exemple donné elle ne garde qu'un seul mot oui

le souci c'est qu'elle est très lourde

y a t'il moyen de l'alléger

de plus y a t'il moyen qu'elle me reclasse tous les mots en haut de la colonne sans que je sois obliger de le faire manuellement en cliquant sur A-> Z ?

d'avance merci de me dire si c'est possible, ci-dessous la macro et si possible de m'aider pour la modification car je suis très mauvaise en macro



Sub virer_doublons()

Dim maPlage As Range
Range(Selection, Selection.End(xlDown)).Select
Set maPlage = Selection

For i = 1 To maPlage.Cells.Count
a = maPlage.Cells(i).Value
If a = "" Then
GoTo line1
End If

For j = i + 1 To maPlage.Cells.Count
b = maPlage.Cells(j).Value
If a = b Then
maPlage.Cells(j).Value = ""
maPlage.Cells(i).Value = ""
End If
Next j

line1:
Next i
End Sub

 

[kjin]

Re : alléger une macro

Bonsoir,
Peut-être comme ceci, les valeurs de la sélection étant filtrées sur place.
A+
kjin

Sub virer_doublons()
Dim maPlage As Range, Unique As New Collection, Swap1, Swap2
Set maPlage = Selection
For Each Cel In maPlage
    If Application.CountIf(maPlage, Cel) = 1 Then
        Unique.Add Cel.Value
    End If
Next
    For i = 1 To Unique.Count - 1
        For j = i + 1 To Unique.Count
            If Unique(i) > Unique(j) Then
                Swap1 = Unique(i)
                Swap2 = Unique(j)
                        Unique.Add Swap1, before:=j
                        Unique.Add Swap2, before:=i
                            Unique.Remove i + 1
                            Unique.Remove j + 1
            End If
        Next j
    Next i
maPlage.ClearContents
For k = 1 To Unique.Count
Cells(k, maPlage.Column) = Unique(k)
Next
End Sub

A+
kjin

 

[ledzepfred]

Re : alléger une macro

Bonsoir,

on ne peut pas dire que ta macro supprimes les doublons, elle supprime toutes les valeurs identiques qui se suivent. donc si tu as maman en A10 et A20 avec des valeurs differentes entre A10 et A20 , après l'execution du code tu auras deux fois maman dans ton fichier (si c'est pas un doublon ça!!).
De plus si ta colonne est triée elle supprime carrément toutes valeurs dont le nombre est supérieur à un dans ta plage (c'est de la suppression radicales de doublons!!)
M'enfin si c'est ce que tu veux ci-dessous la macro1
Par contre si tu souhaites conserver au moins une valeur (renvoyer le résultat papa maman oui non dans ton exemple) prends plutot la macro2

Sub Macro1()

Dim maPlage As Range, REF As String
Range(Selection, Selection.End(xlDown)).Select
Set maPlage = Selection
Do While IsEmpty(ActiveCell) = False
REF = ActiveCell.Value
x = Application.WorksheetFunction.CountIf(maPlage, REF)
If x > 1 Then
For i = 1 To x
maPlage.Find(what:=REF).Delete shift:=xlUp
Next
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Sub Macro2()

Dim maPlage As Range, REF As String

Range(Selection, Selection.End(xlDown)).Select
Set maPlage = Selection
Do While IsEmpty(ActiveCell) = False
REF = ActiveCell.Value
x = Application.WorksheetFunction.CountIf(maPlage, REF)
If x > 1 Then
For i = 1 To x-1
maPlage.Find(what:=REF).Delete shift:=xlUp
Next
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

edit: desolé pour la collision kjin (bonsoir)
A+

 

[Davidc57]

Re : alléger une macro

Bonjour,

Personnellement j'utilise la fonction filtre avancé dans 'Données'. Un enregistrement automatique génère un code très facile à comprendre et le résultat est très rapide.

A+
David