Nouvelle fonction excel "occurence" pour détecter les doublons quand on ne peut pas trier la feuille

Description

Pour répondre à la demande du membre SNOFNIE
qui ne peut ni trier sa feuille ni en supprimer les doublons avec les methodes classiques d'excel.

Cette fonction detecte les doublons sans trier la feuille
Pour le premiere occurence d'un identifiant la fonction retourne 1
Pour toutes les autres occurences la fonction retourne "n"

Source / Exemple :


Public Function Occurence(oCell As Range, oRange As Range)
  
   ' ----------------------------------------------------------------------------
   ' Nouvelle fonction Excel par BILLOT Michel 20120530
   ' Détermine s'il s'agit de la premiere occurence de la cellule oCell sur la plage oRange
   ' Pour identifier les doublons sans avoir à trier la feuille
   ' ----------------------------------------------------------------------------
   ' Retourne
   '    "#" si la cellule cherchee ne fait pas partie de la plage ou si plage au lieu de celleule cherchee
   '    ""  si la valeur cherchee est vide
   '     1  s'il s'agit de la premiere occurence de la cellule sur la plage
   '    "n" pour toutes les autres occurences de la valeur
   
   ' Exemple d'utilisation dans une formule Excel
   '      =Occurence(D222,D$2:D$857)
   '
   ' Exemple d'utilisation pour générer la formule dans la cellule F19
   '       Range("F19").Formula = "=occurence(D19,D$2:D$857)"
   '
   ' Exemple d'utilisation de la fonction directement en VBA
   '    Select Case Occurence(Range("D19"), Range("D$2:D$857"))
   '       Case Is = 1
   '       Case Else
   '    End Select
   
   Dim wCell As Range
   Dim Found%, Ctr%
   
   If oCell.Cells.Count = 1 Then
      For Each wCell In oRange
         If Not IsEmpty(wCell.Value) Then
            If wCell.Value = oCell.Value Then
               ' Cellule contenant la valeur demandée
               Ctr% = Ctr% + 1
            End If
         End If
         If wCell.Address = oCell.Address Then
            ' Cellule recherche trouvée dans la plage
            Found% = True
            Exit For
         End If
      Next wCell
   End If
   
   If Found% Then
      Select Case Ctr%
         Case Is = 0:    Occurence = ""     ' Cellule vide recherchée
         Case Is = 1:    Occurence = 1      ' 1 ere occurence
         Case Else:      Occurence = "n"    ' n eme occurence
      End Select
   Else
      ' Erreur d'utilisation
      ' La cellule recherchee n'est pas sur la plage indiquée
      ' ou bien c'est une plage qui est cherchee au lieu d'une cellule
      Occurence = "#"
   End If
         
End Function

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.