Macro: Supprimer les doublons

[Lucie]

Avec le fichier c'est mieux.... dslée....

Bonjour à tous !

J'aurais besoin de votre aide pour une macro.....

Je souhaiterai utiliser une macro qui me permettrait de supprimer les lignes en doublon càd les lignes pour lesquelles une lettre apparaît plusieurs fois dans une même colonne... est ce possible ?

Je vous ai joint un fichier 'exemple'.

Merci pour votre aide !! [file name=Classeur1_20051011193509.zip size=1649]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur1_20051011193509.zip[/file]

 

[albert]

Bonsoir Lucie, forumiens et forumiennes,

colle ce code dans un module code Zon)
Lien supprimé


Sub Princ()
Dim Plage As Range
Dim T
Set Plage = Range([A2], [A65536].End(xlUp)) 'à adapter
T = Doublons(Plage.Value, 1) 'Doublons sure la 1 ere colonne
If IsArray(T) Then
T = InverseTab(T, 1)
With Plage
.Clear
.Cells(1, 1).Resize(UBound(T), UBound(T, 2)) = T
End With
Else: MsgBox T
End If
End Sub


Function Doublons(T, ColT As Byte) 'Zon
Dim I&, J&, K&, Tablo As New Collection
Dim Temp()
For I = LBound(T, 1) To UBound(T, 1)
On Error Resume Next
Tablo.Add T(I, ColT), CStr(T(I, ColT))
If Err = 0 Then
ReDim Preserve Temp(1 To UBound(T, 2), 1 To J + 1)
For K = 1 To UBound(Temp)
Temp(K, J + 1) = T(I, K)
Next K
J = J + 1
End If
Next I
Doublons = IIf(J > 0, Temp, 'Pas de doublons')
End Function
Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), I&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For I = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(I, J) = T(J, I)
Next J
Next I
InverseTab = Temp
End Function



albert