Recherche & référence HasDoublons

Magic_Doctor

XLDnaute Barbatruc
Vérifie si dans une plage de cellules contiguës, disposées sur une ligne ou une colonne, il y a au moins un doublon.

VB:
Function HasDoublons(Plage As Range)
'********************************************************************************************************************
'Vérifie si dans une plage de cellules contiguës, disposées sur une ligne ou une colonne, il y a au moins un doublon
'********************************************************************************************************************
'- Si doublon(s)  --> True
'- Si pas doublon --> False

Dim Coll As New Collection, cell As Range
  On Error Resume Next
  For Each cell In Plage
    If cell.Text <> "" Then Coll.Add "zaza", cell.Text
  Next
  Err.Clear
  HasDoublons = Not (Coll.Count = Plage.Count)
End Function
 
Salut Magic_Doctor, le forum

J'aurais plutôt renvoyé le nombre de doublons.
Voire, en paramètre optionnel, les range des doublons ce qui permettrait de les traiter directement en appel VBA, mais ce n'est qu'une suggestion.

Cordialement, @+
 
Dernière édition:
un truc comme ça !
Code:
Function HasDoublons(Plage As Range, Optional D_Plage As Boolean = 0)
'********************************************************************************************************************
'Vérifie si dans une plage de cellules contiguës, disposées sur une ligne ou une colonne, il y a au moins un doublon
'********************************************************************************************************************
'- Si doublon(s)  --> Nbr de doublons
'- Si pas doublon --> 0

Dim Coll As New Collection, cell As Range, Cells_Doublons As Range
    On Error Resume Next
    For Each cell In Plage
        If cell.Text <> "" Then Coll.Add "zaza", cell.Text
        If Err > 0 Then If Cells_Doublons Is Nothing Then Set Cells_Doublons = cell Else Set Cells_Doublons = Union(Cells_Doublons, cell)
        Err.Clear
    Next cell
    HasDoublons = IIf(D_Plage, Cells_Doublons.Address, Plage.Count - Coll.Count)
End Function


Sub test_doublons()
Range(HasDoublons(Range("B15:B25"), 1)).Select
End Sub
 
avec une petite modif pour incorporer ou non les cellules vides dans les doublons
VB:
Function HasDoublons(Plage As Range, Optional Cells_Empty As Boolean = 0, Optional D_Plage As Boolean = 0)
'********************************************************************************************************************
'Vérifie si dans une plage de cellules contiguës, disposées sur une ligne ou une colonne, il y a au moins un doublon
'********************************************************************************************************************
'- Si doublon(s)  --> Nbr de doublons
'- Si pas doublon --> 0
'Paramètre Cells_Empty optionel pour prendre en compte les cellules vides
'Paramètre D_Plage optionel pour renvoyer l'adresse des doublons
Dim Coll As New Collection, cell As Range, Cells_Doublons As Range, Nbr_Empty&
    On Error Resume Next
    For Each cell In Plage
        If cell.Text <> "" Then
            Coll.Add "zaza", cell.Text
            If Err > 0 And D_Plage Then If Cells_Doublons Is Nothing Then Set Cells_Doublons = cell Else Set Cells_Doublons = Union(Cells_Doublons, cell)
            Err.Clear
        Else
            If Cells_Empty Then
                If D_Plage Then If Cells_Doublons Is Nothing Then Set Cells_Doublons = cell Else Set Cells_Doublons = Union(Cells_Doublons, cell)
                Nbr_Empty = Nbr_Empty + 1
            End If
        End If
    Next cell
    If D_Plage Then
        If Cells_Doublons Is Nothing Then HasDoublons = "" Else HasDoublons = Cells_Doublons.Address
    Else
        HasDoublons = Plage.Count - Coll.Count + Nbr_Empty
    End If
End Function


Sub test_doublons()
If Not HasDoublons(Range("B15:B25"), 1, 1) = "" Then Range(HasDoublons(Range("B15:B25"), 1, 1)).Select Else MsgBox "Pas de doublons.", vbOKOnly + vbInformation
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Cette fonction devrait le faire aussi :
Code:
Function AvecDoublon(unePlage As Range) As Boolean
   AvecDoublon = Application.Evaluate(Replace("=MAX(COUNTIF(xxx,xxx))>1", "xxx", unePlage.Address))
End Function
nota : ne prend pas en compte les cellules vides

ou bien avec prise en compte des cellules vides :

VB:
Function AvecDoublonEtVide(unePlage As Range) As Boolean
Dim x, y
   x = Application.Evaluate(Replace("=MAX(COUNTIF(xxx,xxx))>1", "xxx", unePlage.Address))
   y = (unePlage.Count - Application.Evaluate(Replace("=COUNTIF(xxx,""<>"")", "xxx", unePlage.Address))) > 1
   AvecDoublonEtVide = x Or y
End Function
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonsoir Magic_Doctor, Yeahou, mapomme,

je ne comprends pas ; il suffit de faire cette formule Excel :

=SI(NB.SI(Plage, Valeur_cherchée)>1;"Doublon";"Unique")

retour : "Doublon" ou "Unique"



ou autre exemple :

=NB.SI(Plage, Valeur_cherchée)>1

retour : VRAI ou FAUX (c'est des valeurs booléennes, pas du texte)



si tu tiens vraiment à l'faire en VBA, j'te laisse faire la conversion. 😜

soan
 

soan

XLDnaute Barbatruc
Inactif
@mapomme

oh ! désolé : j'savais pas qu'c'était COUNTIF qui est l'équivalent de NB.SI, alors j'ai pas réalisé. :oops:

ou plutôt : c'est tellement rare que j'utilise COUNTIF() que j'avais oublié qu'c'est ce mot-clé l'équivalent de NB.SI()



malgré ça, je pense qu'une formule Excel suffit, pas besoin de VBA ! :)

j'en reviens pas, lolllll : c'est moi qui dit ça, que c'est inutile d'utiliser VBA ! 🤣

soan
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
457

Statistiques des forums

Discussions
311 730
Messages
2 081 989
Membres
101 856
dernier inscrit
Marina40