Macro Doublons

[Art]

Bonjour à tous et Joyeuses Paques à tout le Forum

Voila mon probleme, j'ai trouvé cette Macro sur un Forum ( je n'ai hélas plus le nom de l'auteur) et elle permet de faire une recherche de doublons dans une BDD en selectionnant plusieurs critères.
J'aurais aimé la rendre plus "conviviale" en faisant apparaitre par exemple un UserForm me demandant les critères à selectionner au lieu d'avoir à intervenir dans la Macro pour changer les paramètres, ceci afin que n'importe quel utilisateur puisse s'en servir.
Mais celà dépasse de loin mes compétences.
Es-ce qu'un sympathique Excellien (ou Excellienne) pourrait me donner un coup de pouce?
Voici la Macro

Sub Doublons()
Dim CheckRows As Range
Dim ColumnsToMatch As Variant
Dim DeleteDuplicates As Boolean
Dim FormatDuplicates As Boolean
Dim WriteListOfDuplicates As Boolean
Dim AddRowNumberToList As Boolean
Dim lLBound As Long
Dim lUBound As Long
Dim CheckRange As Range
Dim SubArray As Variant
Dim FieldsCollection As New Collection
Dim RowNumberCollection As New Collection
Dim dummy As Long
Dim DuplicateRange As Range
Dim DuplicatesExist As Boolean
Dim lRow As Long
Dim CollectionKey As String
Dim OffsetValue() As Long
Dim StartCell As Range
Dim Element As Variant
Dim Counter As Long

'adapter les 6 variables ci-dessous pour mettre à jour
'les paramètres de travail de la macro

Set CheckRows = Rows("1:511") 'nombre de lignes du fichier(à modifier)
ColumnsToMatch = Array("A", "B", "C", "D", "E", "F") 'colonnes à tester(peuvent etre changées)
DeleteDuplicates = False 'supression des doublons
FormatDuplicates = True 'mise en évidence des doublons(couleur rouge)
WriteListOfDuplicates = True 'crée une autre feuille avec les doublons
AddRowNumberToList = True 'rajoute le N° de ligne ou etait les doubles


lLBound = LBound(ColumnsToMatch)
lUBound = UBound(ColumnsToMatch)

Set CheckRange = Intersect(Range(ColumnsToMatch(lLBound) & _
":" & ColumnsToMatch(lLBound)), CheckRows)

ReDim OffsetValue(lUBound - lLBound + 1)

For Counter = lLBound To lUBound
OffsetValue(Counter) = Range(ColumnsToMatch(Counter) & ":" & _
ColumnsToMatch(Counter)).Column - CheckRange.Column
Next Counter

On Error Resume Next
SubArray = CheckRange.Value
For lRow = 1 To UBound(SubArray, 1)
If SubArray(lRow, 1) <> "" Then
CollectionKey = ""
For Counter = lLBound To lUBound
CollectionKey = CollectionKey & _
CheckRange(lRow, 1).Offset(0, _
OffsetValue(Counter)).Value
Next Counter
FieldsCollection.Add dummy, CStr(CollectionKey)
If Err.Number = 457 Then
Err.Clear
DuplicatesExist = True
RowNumberCollection.Add CheckRange(lRow, 1).Row
If DuplicateRange Is Nothing Then
Set DuplicateRange = _
CheckRange.Cells(lRow, 1)
Else
Set DuplicateRange = Union(DuplicateRange, _
CheckRange.Cells(lRow, 1))
End If
End If
End If
Next lRow
On Error GoTo 0

If DuplicatesExist = False Then
MsgBox "Il n'y a pas de doublons.", vbInformation
Else
With DuplicateRange.EntireRow
If WriteListOfDuplicates Then
Worksheets.Add After:=DuplicateRange.Parent
.Copy Destination:=Range("A1")
If AddRowNumberToList Then
Columns("A").Insert
Set StartCell = Range("A1")
For Each Element In RowNumberCollection
StartCell.Value = "Row " & Element
Set StartCell = StartCell.Offset(1, 0)
Next Element
End If
End If
If FormatDuplicates Then .Font.ColorIndex = 3
If DeleteDuplicates Then .Delete
End With
End If

End Sub

@+
Art

 

[michel]

Re: Macro Doublons avec choix d'option

bonjour Art

peux tu envoyer sur le forum un fichier zippé expliquant ce que recherches à obtenir

en attendant ,le lien ci dessous pourra peut etre t'aider

Lien supprimé


bonn week end
michel

 

[Art]

Re: Macro Doublons avec choix d'option

Bonjour Michel et merci de ta reponse rapide.
En faite, ce que je désire obtenir avec cette Macro c'est que lorsque je la lance, elle me presente un UserForm ou je puisse choisir les parametres desirés (Nb de lignes du fichier, option d'effacement des doublons, mise en évidence de ceux-ci ...etc). Et que toutes ces variables prennent place dans la Macro (jusqu'a present je les écrit en "dur" dans la macro).
Je suis allé voir le lien que tu m'as présenté et ta macro est super mais on ne peut apparement pas faire de recherche sur 2,3,4...etc champs à la fois ce qui m'est indispensable, par contre je vais surement y piocher des idées (avec ton autorisation bien sur ) lorsque je l'aurais décortiqué
@+
Art