Correction Fonction personnalisée

Bonjour à tous,

Ce post est pour une correction / amélioration d'une fonction personnalisée que je viens d'écrire...

Function DOUBLON(Plage As Range)
Nn = 0
    For Each cel In Plage
        rep = Application.WorksheetFunction.CountIf(Plage, cel) - 1
        If rep > 0 Then
            Nn = Nn + rep
        End If
    Next
If Nn <> 0 Then
        DOUBLON = True
    Else
        DOUBLON = False
End If
End Function

Concrètement elle fonctionne sans soucis si une seule plage est sélectionnée. C'est le minimum requis de ma part.

  • Premièrement, pensez vous à une solution plus "rapide" ou plus "clean" niveau syntaxe pour arriver au même résultat?
  • Quand on sélectionne plusieurs plages de cellule (via Ctrl) on a '#VALEUR"... Comment faire pour que ça marche quand même?

Vu que ça fonctionne déjà c'est pas urgent, mais je veux bien des réponses quand même pour m'améliorer (d'autant que les boucles c'est pas mon truc)

Merciiiii

Bonjour,

Plusieurs remarques après une première lecture rapide de votre code.

1 / Algorithmiquement, le code me semble juste.

2/ La fonction dit simplement s'il y a présence d'au moins un doublon, mais on ne sait pas s'il y en a un ou beaucoup, et si c'est sur un élément, ou plusieurs.

3/ Pour optimiser l'algorithme, on passe généralement par une étape préliminaire de tri ce qui facilite l'identification des doublons.

4/ Pour l'erreur rencontrée, VBA ne doit pas accepter des plages disjointes, mais ne saurais vous proposer des solutions instantanément.

En espérant que d'autres membres du forum puissent vous apporter des compléments.

À vous lire,

Salut Atro,

Salut Fatos,

mêmes remarques!

Pour la suite, il faudra passer par...

Selection.areas

Ça demande un peu de temps. Pas de panique!

A+

Salut le fil,

A mon humble avis CountIf ne prend pas en charge plusieurs plages Teste avec Union, sinon avec CountIfs

Salut l'équipe,

à mon sens, UNION ne peut fonctionner que dans le cadre d'une SUB or, ici, Atro veut sélectionner les plages lui-même avec CTRL donc, l'usage de AREAS me semble obligatoire.

A+

Bonjour,

une possibilité,

=DoubonPlage(A1;B4:B5;B9:B10)

Function DoubonPlage(cel As Range, ParamArray Ranges() As Variant)
For i = LBound(Ranges) To UBound(Ranges)
        rep = rep + Application.WorksheetFunction.CountIf(Ranges(i), cel)
        If rep > 1 Then DoubonPlage = True Else DoubonPlage = False
Next i
End Function

Salut Atro,

Salut l'équipe,

voici 2 solutions avant que je ne cherche une solution MFC trouvée ici, pas encore essayée, des mains de notre maître ès formules, Tulipe_4.

https://forum.excel-pratique.com/viewtopic.php?t=39553

1e solution dans 'AREAS-Variable'

  • pour une seule Range à traiter, tu laisses [A1] en vert (MONO) ;
  • pour plusieurs Range dont tu ne connais pas le nombre en commençant, tu cliques sur [A1] qui vire au rouge (MULTI) ;
  • tu sélectionnes alors les différents Range SANS utiliser CTRL !
  • quand tu as ton lot de Range à traiter, tu recliques sur [A1] -> traitement ;
  • inconvénient : tu n'as plus les sélections à l'écran sauf à encadrer de bordures les différents Range ce qui risque d'abîmer tes bordures existantes.

2e solution dans 'AREAS-Fixe'

  • tu indiques en [A1] le nombre de Range (!! et obligatoire, dès lors !!) que tu souhaites sélectionner AVEC CTRL, cette fois-ci ;
  • inconvénient : tu es obligé de t'en tenir au nombre de sélections encodé en [A1].
If iIdx > 0 Then
    sMsg = sMsg & IIf(sMsg = "", "", Chr(10)) & Replace(Replace(rCells.Address, "$", ""), ":", " : ") & Chr(10)
    For x = 0 To iIdx - 1
        sMsg = sMsg & tTab(0, x) & "  :  " & tTab(1, x) & "  fois." & Chr(10)
    Next
End If

Résultats dans une MsgBox.

A+

2atro.xlsm (27.24 Ko)

Salut Atro,

Salut l'équipe,

trouvé la solution-miracle qui réunit le meilleur des 2 méthodes postées précédemment sur la Toile, des mains d'une certaine Isabelle, postée sur un forum en 2008!

Honneur aux Isabelle !

Plus besoin de mentionner le nombre de Range à sélectionner ni de cellule à colorer :

  • tu te contentes de sélectionner le nombre de Range souhaité en poussant CTRL dès la première sélection (qui sera en fait la seconde puisqu'il y toujours une cellule quelconque déjà sélectionnée quelque part dans la feuille!) ;
  • !! Attention !! Il faut absolument lâcher CTRL avant de relâcher le bouton de la souris lors de la dernière sélection sinon tu es reparti pour une nouvelle sélection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Application.EnableEvents = False
'
If GetAsyncKeyState(17) = 0 Then
    sMsg = ""
    For x = 1 To Selection.Areas.Count
        If Selection.Areas(x).Count > 1 Then
            Set rCells = Selection.Areas(x)
            Call Doublons(rCells)
        End If
    Next
    MsgBox IIf(sMsg <> "", sMsg, "Pas de doublons!"), vbInformation + vbOKOnly, "Doublons"
    [A1].Select
End If
'
Application.EnableEvents = True
'
End Sub

Il faut aussi mettre ceci dans un module standard.

Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Integer) As Integer

A tester dans la feuille 'AREAS-GetAsync'.

A+

3atro.xlsm (29.55 Ko)

Bonjour à tous, merci pour se florilège de réponses

Salut Atro,

Salut Fatos,

mêmes remarques!

Pour la suite, il faudra passer par...

Selection.areas

Ça demande un peu de temps. Pas de panique!

A+

A priori cette méthode fonctionne, mais pas parfaitement, je me retrouve parfois avec #VALEUR sur certaines séries

Bonjour,

une possibilité,

=DoubonPlage(A1;B4:B5;B9:B10)

Function DoubonPlage(cel As Range, ParamArray Ranges() As Variant)
For i = LBound(Ranges) To UBound(Ranges)
        rep = rep + Application.WorksheetFunction.CountIf(Ranges(i), cel)
        If rep > 1 Then DoubonPlage = True Else DoubonPlage = False
Next i
End Function
Merci pour cette proposition. Sur mon cas elle ne fonctionne pas j'ai des erreurs en systématique, que ce soit sur 1 seule plage de cellules où ça affiche 0 qu'il y ai où non des doublons, ou #VALEUR si plages multiples

Salut Atro,

Salut l'équipe,

trouvé la solution-miracle qui réunit le meilleur des 2 méthodes postées précédemment sur la Toile, des mains d'une certaine Isabelle, postée sur un forum en 2008!

Honneur aux Isabelle !

Plus besoin de mentionner le nombre de Range à sélectionner ni de cellule à colorer :

  • tu te contentes de sélectionner le nombre de Range souhaité en poussant CTRL dès la première sélection (qui sera en fait la seconde puisqu'il y toujours une cellule quelconque déjà sélectionnée quelque part dans la feuille!) ;
  • !! Attention !! Il faut absolument lâcher CTRL avant de relâcher le bouton de la souris lors de la dernière sélection sinon tu es reparti pour une nouvelle sélection.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Application.EnableEvents = False
'
If GetAsyncKeyState(17) = 0 Then
    sMsg = ""
    For x = 1 To Selection.Areas.Count
        If Selection.Areas(x).Count > 1 Then
            Set rCells = Selection.Areas(x)
            Call Doublons(rCells)
        End If
    Next
    MsgBox IIf(sMsg <> "", sMsg, "Pas de doublons!"), vbInformation + vbOKOnly, "Doublons"
    [A1].Select
End If
'
Application.EnableEvents = True
'
End Sub

Il faut aussi mettre ceci dans un module standard.

Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Integer) As Integer

A tester dans la feuille 'AREAS-GetAsync'.

A+

Je vais tester ça dans les prochaines minutes mais le but initial c'est créer une fonction utilisable par n'importe qui, qu'il soit un Klampin ou expérimenté. Juste un module à importer et paf. A voir sur l'adaptation. (c'est ma 18° fonction personnalisée par import d'un module ^^)

re,

voici un fichier exemple,

re,

voici un fichier exemple,

Function perso avec ParamArray.xlsm

Attention, j'ai déjà une fonction personnalisée qui me détecte un doublon spécifique dans une plage de cellules (écrite par mon père il y a quelques années et ça fonctionne du tonnerre). Tu as mis "a" en critère de recherche mais la fonction que je souhaite c'est sans aucun critères de recherche ^^.

Tu as mis "a" en critère de recherche mais la fonction que je souhaite c'est sans aucun critères de recherche ^^.

voici la modification sans critère de recherche

Function DoubonPlage(ParamArray Ranges() As Variant) As Boolean
Dim i As Long, rep As Long, c As Range
For i = LBound(Ranges) To UBound(Ranges)
  For Each c In Ranges(i)
    rep = rep + Application.WorksheetFunction.CountIf(Ranges(i), c)
    If rep > 1 Then DoubonPlage = True Else DoubonPlage = False
  Next c
Next i
End Function
Rechercher des sujets similaires à "correction fonction personnalisee"