Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Je suis à la recherche d'une fonction qui, comme il est stipulé dans le titre du fil, recherche, dans une plage de cellule, s'il y a ou pas un ou des doublons. Supposons que nous nommions cette fonctions "Doublons" :
VB:
Sub Function Doublons (plage As Range) As Boolean
blablabla
End Function
La fonction renvoyant uniquement "True" ou "False" suivant qu'il y ait ou pas un ou des doublons.
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Bonjour Magic_Doctor.
Peut-être ceci ?
VB:
Function Doublons(plage As Range) As Boolean
'Nécessite l'ajout de la bibliothèque Microsoft Scripting Runtime au projet.
Dim Cel As Range, Dic As New Dictionary
On Error GoTo E
For Each Cel In plage.Cells: Dic.Add CStr(Cel.Value), True: Next
Exit Function
E: Doublons = True
End Function
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Bonjour Magic_Doctor,
Un essai dans le fichier joint.
La fonction peut s'écrire:=Doublons(Plage1 [;Plage2;...;Plage n ] [;MinMajDiff = VRAI ou FAUX]) .
=doublons(A1:A6;A9:A11;C3:C8) recherche si doublon(s) (ne distingue pas les majuscules des minuscules)
=doublons(A1:A6;A9:A11;C3:C8;FAUX) recherche si doublon(s) (ne distingue pas les majuscules des minuscules)
=doublons(A1:A6;A9:A11;C3:C8;VRAI) recherche si doublon(s) (distingue les majuscules des minuscules)
Si le dernier paramètre est VRAI: on distingue les majuscules des minuscules ( A est différent de a)
Si le dernier paramètre est FAUX ou non indiqué: on ne distingue pas les majuscules des minuscules ( A est égal à a)
En fait l'écriture minimale est : Doublons(plage1) qui recherche les doublons sur une plage unique en faisant fi de la casse et des cellules vides.
Dans tous les cas, on ne prend pas en compte les cellules vides.
VB:
Public Function Doublons(ParamArray Plages()) As Boolean
Dim dico As New Scripting.Dictionary, xplage, xrg As Range
Dim Nmax As Long, MinMajDiff As Boolean, i As Long, S As String
If VarType(Plages(UBound(Plages))) = vbBoolean Then
Nmax = UBound(Plages) - 1
MinMajDiff = Plages(UBound(Plages))
Else
Nmax = UBound(Plages)
MinMajDiff = False
End If
For i = LBound(Plages) To Nmax
For Each xrg In Plages(i)
S = CStr(xrg)
If Not MinMajDiff Then S = LCase(S)
If Not S = "" Then
If dico.Exists(S) Then
Doublons = True
Exit Function
Else
dico(S) = ""
End If
End If
Next xrg
Next i
End Function
Edit : tout comme ROGER2327 que je salue 🙂 , il faut une référence à Microsoft Scripting Runtime pour utiliser les structures Dictionary.
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Suite...
Bonjour mapomme.
Avec le paramétrage que vous décrivez, je propose :
VB:
Function Doublons2(ParamArray Plages()) As Boolean 'Ignore les cellules vides.
'Nécessite l'ajout de la bibliothèque Microsoft Scripting Runtime au projet.
Dim i&, Mm As Boolean, Tf As Boolean, Cel As Range, Dic As New Dictionary
Tf = VarType(Plages(UBound(Plages))) = vbBoolean
If Tf Then Mm = Plages(UBound(Plages))
For i = LBound(Plages) To UBound(Plages) + Tf
On Error GoTo E
If Mm Then
For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then Dic.Add CStr(Cel.Value), True
Next
Else
For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then Dic.Add UCase(CStr(Cel.Value)), True
Next
End If
Next
Exit Function
E: Doublons2 = True
End Function
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Suite...
Peut-être un poil plus rapide :
VB:
Function Doublons3(ParamArray Plages()) As Boolean 'Ignore les cellules vides.
'Nécessite l'ajout de la bibliothèque Microsoft Scripting Runtime au projet.
Dim i&, Mm As Boolean, Tf As Boolean, Cel As Range, Dic As New Dictionary
Tf = VarType(Plages(UBound(Plages))) = vbBoolean
If Tf Then Mm = Plages(UBound(Plages))
On Error GoTo E
If Mm Then
For i = LBound(Plages) To UBound(Plages) + Tf: For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then Dic.Add CStr(Cel.Value), True
Next Cel, i
Else
For i = LBound(Plages) To UBound(Plages) + Tf: For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then Dic.Add UCase(CStr(Cel.Value)), True
Next Cel, i
End If
Exit Function
E: Doublons3 = True
End Function
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Bonsoir à tous, et tout d’abord merci à Roger & mapomme.
Sujet intéressant non tant par la demande mais par les réponses.
Dans mon application j’utilise souvent le « Dictionary » sans problèmes jusqu’à présent.
J’essaie la fonction de ROGER2327 :
VB:
Function Doublons(plage As Range) As Boolean
'Vérifie si dans une plage il y a ou pas un ou des doublons
'ROGER2327
Dim Cel As Range, Dic As New Dictionary
On Error GoTo E
For Each Cel In plage.Cells: Dic.Add CStr(Cel.Value), True: Next
Exit Function
E: Doublons = True
End Function
Ça plante (Traduction : “Erreur de compilation : le type défini par l’usager n’a pas été défini“).
mapomme précise bien qu’il faut une référence à Microsoft Scripting Runtime pour utiliser les structures Dictionary. J’avoue, au passage, que les concepteurs de ce programme nous les cassent un peu dans certains paramétrages préalables pour que tout marche correctement. Je n’ai toujours pas compris pourquoi ils ne l’étaient pas d’emblée et que l’on n’en parle plus !
Bref, je ne me pose pas de question et modifie un chouïa la fonction de Roger :
VB:
Function Doublons(plage As Range) As Boolean
'Vérifie si dans une plage il y a ou pas un ou des doublons
'ROGER2327
Dim Cel As Range, Dic As Object
Set dico = CreateObject("Scripting.Dictionary")
On Error GoTo E
For Each Cel In plage.Cells: Dic.Add CStr(Cel.Value), True: Next
Exit Function
E: Doublons = True
End Function
Et là ça marche !
Avant même de poser cette question sur ce fil, je me demandais si la présence de cellules vierges n’interfèreraient pas dans la recherche de doublons. Aussi, j’ai rédigé une petite fonction pour que la recherche ne se fasse que dans le segment du tableau où il y a des cellules qui contiennent quelque chose :
VB:
Function PlagePleine(plage As Range) As String
'Renvoie l'adresse de la plage non vide d'un tableau
'Magic_Doctor
Dim nbtotallgn As Integer, nblgnvides As Integer
nbtotallgn = plage.Rows.Count
nblgnvides = WorksheetFunction.CountBlank(plage)
PlagePleine = plage.Rows(1).Resize(nbtotallgn - nblgnvides).Address
End Function
Je précise, au passage, que dans mon application toutes les cellules non vides du tableau sont contiguës quoi qu’il arrive (si on effaçait le contenu de l’une des cellules, automatiquement l’ensemble des autres cellules au-dessous serait déplacé d’une ligne vers le haut).
Pour finalement combiner les 2 fonctions dans cet exemple de macro :
VB:
Sub Tralala()
'La recherche se fait dans la 1ère colonne d'une plage nommée "ListeItems1"
[S9] = Doublons(Range(PlagePleine([ListeItems1].Columns(1)))) 'vérifie (cellule "S9") la présence ou pas de doublon(s) uniquement dans les cellules non vides du tableau "LiteItems1"
End Sub
En tout cas, merci pour votre aide.
PS : comment fait donc Roger pour mettre autant de couleurs dans ses exemples de routines ? C’est bô !
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Oun essai para la rigolada.
VB:
Function Doublons(plage As Range) As Boolean
'Vérifie si dans une plage il y a ou pas un ou des doublons
'ROGER2327
Dim Cel As Range, Dic As Object
Set dico = CreateObject("Scripting.Dictionary")
On Error GoTo E
For Each Cel In plage.Cells: Dic.Add CStr(Cel.Value), True: Next
Exit Function
E: Doublons = True
End Function
Dans la dernière solution, la valeur de Mm est moins souvent testée.
Quant à votre modification, elle est astucieuse. Personnellement, je me méfie un peu de la notion de blank vue par le Bill's Band. Mais j'ai probablement tort...
Ceci dit, voici une version plus courte de mes propositions précédentes :
VB:
Function Doublons(ParamArray Plages()) As Boolean 'Ignore les cellules vides.
'Nécessite l'ajout de la bibliothèque Microsoft Scripting Runtime au projet.
Dim i&, Cel As Range, Dic As New Dictionary
i = UBound(Plages)
If VarType(Plages(i)) = 11 Then Dic.CompareMode = -Not Plages(i): i = i - 1 Else Dic.CompareMode = 1
On Error GoTo E
For i = 0 To i: For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then Dic.Add CStr(Cel.Value), True
Next Cel, i
Exit Function
E: Doublons = True
End Function
Si on est certain, comme vous, de n'avoir pas de cellule vide dans les plages à contrôler :
VB:
Function Doublons(ParamArray Plages()) As Boolean 'N'ignore pas les cellules vides.
'Nécessite l'ajout de la bibliothèque Microsoft Scripting Runtime au projet.
Dim i&, Cel As Range, Dic As New Dictionary
i = UBound(Plages)
If VarType(Plages(i)) = 11 Then Dic.CompareMode = -Not Plages(i): i = i - 1 Else Dic.CompareMode = 1
On Error GoTo E
For i = 0 To i: For Each Cel In Plages(i).Cells: Dic.Add CStr(Cel.Value), True: Next Cel, i
Exit Function
E: Doublons = True
End Function
Re : Une fonction (VBA) qui repère s'il y a un ou des doublons
Bonsoir ROGER2327,
Pas pu répondre avant.
Merci pour ces modifications intéressantes. Mais ayant encore des progrès à accomplir (largo es el camino...), j'avoue que certaines sentences me déconcertent, comme : Dic.CompareMode = -Not
Comme précédemment, j'ai fait la petite modification suivante :
VB:
Function Doublons(ParamArray Plages()) As Boolean
'Vérifie si dans une plage il y a ou pas un ou des doublons (ignore les cellules vides)
'ROGER2327
Dim i&, Cel As Range, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
i = UBound(Plages)
If VarType(Plages(i)) = 11 Then dico.CompareMode = -Not Plages(i): i = i - 1 Else dico.CompareMode = 1
On Error GoTo E
For i = 0 To i: For Each Cel In Plages(i).Cells
If Not IsEmpty(Cel.Value) Then dico.Add CStr(Cel.Value), True
Next Cel, i
Exit Function
E: Doublons = True
End Function
Bien que la fonction que j'avais rédigée soit maintenant superflue, j'en ai quand même profité pour la simplifier :
VB:
Function PlagePleine(plage As Range) As String
'Renvoie l'adresse de la plage non vide d'un tableau dont les lignes pleines sont toujours contiguës
'Magic_Doctor
Dim nblgnfull As Integer
nblgnfull = WorksheetFunction.CountA(plage) 'décompte du nombre de lignes pleines de la plage "plage"
PlagePleine = plage.Rows(1).Resize(nblgnfull).Address
End Function
avec la cellule au format personnalisé "Oui";;"Non"
Cette fonction VBA ne fait que retranscrire la formule précédente :
Code:
Function Doublons(plage As Range) As Byte
Dim a$
a = plage.Address
Doublons = Evaluate("SIGN(ROWS(" & a & ")*COLUMNS(" & a & ")-SUMPRODUCT(1/COUNTIF(" & a & "," & a & ")))")
End Function
Pas pu répondre avant.
Merci pour ces modifications intéressantes. Mais ayant encore des progrès à accomplir (largo es el camino...), j'avoue que certaines sentences me déconcertent, comme : Dic.CompareMode = -Not
Function Doublons(plage As Range) As Byte
Dim a$
a = plage.Address
Doublons = Sgn(Evaluate("SUMPRODUCT((" & a & "<>"""")*(COUNTIF(" & a & "," & a & ")>1))"))
End Function
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD