Attribute VB_Name = "Position_Premier_v130"
'----------------------------------------------------------------------------------------
' Procédure_____: Position_Premier
' Date__________: 21/01/2022
' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=265
' Objet_________: Retourner la première cellule trouvée répondant à un critère
' Référence_____: Fonction de recherche
' Appel_________: Position_Premier(LaValeur, LeRange, Opt. LeType, Opt. LeTest, Opt. PasdInfo, Opt. VideOK))
' Retour________: Adresse, N° de ligne, N° de colonne, Lettre ou Range. 0 ou ! en cas d'erreur
' Options_______: Si LeType := "Adresse", retourne l'adresse complète (par défaut)
' Options_______: Si LeType := "NumLig", retourne le Numéro de Ligne uniquement
' Options_______: Si LeType := "NumCol", retourne le Numéro de Colonne uniquement
' Options_______: Si LeType := "LetCol", retourne les Lettres de Colonne
' Options_______: Si LeType := "Range", retourne le range de la position
' Options_______: Si LeTest := "<=", ">=" ,"<>" (par défaut recherche exacte "=")
' Options_______: Si PasdInfo := true, n'Affiche pas de message si non trouvé
' Options_______: Si VideOK := true, considère qu'un champ vide est à prendre en compte
' Compatibilité_: (2003-2019)Office     (11.0-16.0)Excel     (+)32-bit     (+)64-bit
' Statut________: (x)Validé ()En attente validation ()En cours développement
'----------------------------------------------------------------------------------------
' 2013.02.16 v1.00 DEV Création initiale, fournit l'adresse de la première valeur d'un range
' 2021.03.20 v1.10 BUG La fonction .Find() n'est pas (plus) fonctionnelle sur colonnes masquées.
'                  FIX Refonte complète, compatibilité Office 2019 et Excel 17.
' 2021.10.08 v1.20 DEV Ajoute une option de test basique (/!\ en paramètre avant celui de PasdInfo)
' 2021.10.26 v1.21 DEV Ajout de précisions dans la gestion des erreurs (lieu de la formule, test appliqué, valeur retournée)
' 2022.01.21 v1.30 DEV Ajout la possibilité de tester des chaînes vides et de retourner un range
'                  DEV Améliore la gestion des erreurs de valeur de LeType passés et la compatibilité VBA7
'                  DEV Optimise la zone de recherche passée en paramètre
Option Explicit

Function Position_Premier(ByVal LaValeur As Variant, ByVal LeRange As Range, Optional ByVal LeType As String = "Adresse", Optional ByVal LeTest As String = "=", Optional ByVal PasdInfo As Boolean = False, Optional ByVal VideOK As Boolean = False) As Variant
  '
  ' Memo : Fonction .Find non fonctionnelle sur cellules masquées (xlvalues ou xlFormulas)
  '
  Position_Premier = Empty
  Dim c As Range, valTest As Boolean
  Dim locForm As String
  ' Limitation de la plage
  Set LeRange = Intersect(LeRange, LeRange.Parent.UsedRange)
  ' Recherche LaValeur
  For Each c In LeRange
    valTest = False
    If LeTest = Empty Then LeTest = "="
    ' Combinaison de Tests
    If c.Value <> "" Or VideOK Then
      If InStr(1, LeTest, "<") > 0 Then
        valTest = valTest Or (c.Value < LaValeur)
      End If
      If InStr(1, LeTest, ">") > 0 Then
        valTest = valTest Or (c.Value > LaValeur)
      End If
      If InStr(1, LeTest, "=") > 0 Then
        valTest = valTest Or (c.Value = LaValeur)
      End If
    End If
    ' Test réussi ?
    If valTest Then
      ' Format de sortie spécifique ?
      Select Case UCase(LeType)
       Case "ADRESSE", "" ' Compatibilité Fonction
        ' Choix par Défaut
        Position_Premier = c.Address
       Case "LETCOL"
        ' Colonne sous forme de lettres (type Range)
        Position_Premier = Mid(c.Address, 2, InStr(2, c.Address, "$") - 2)
       Case "NUMCOL"
        ' Colonne sous forme de Numéro de colonne (type Cells)
        Position_Premier = c.Column
       Case "NUMLIG"
        ' Numéro de ligne (type Cells)
        Position_Premier = c.Row
       Case "RANGE"
        ' Range
        Set Position_Premier = c
       Case Else
        ' Choix inconnu
        MsgBox "Le Type : " & LeType & ", passé en argument est inconnu. Les choix possibles sont : LetCol, NumCol, NumLig, Range et Adresse (par défaut)", Buttons:=vbCritical, Title:="Argument Incorrect"
      End Select
      ' Sort de la Boucle à la première occurence
      Exit For
    End If
    ' Boucle à la recherche de la première
  Next c
  ' Erreur (non trouvé) ?
  If TypeName(Position_Premier) <> "Range" And IsEmpty(Position_Premier) Then
    ' Retourne 0 ou "!" si erreur
    If InStr(1, UCase(LeType), "NUM") > 0 Then
      Position_Premier = 0
    Else
      Position_Premier = "!"
    End If
    ' Message d'information si erreur ?
    If Not PasdInfo Then
      locForm = ""
      On Error Resume Next
        locForm = Application.ThisCell.Address
      On Error GoTo 0
      If locForm <> "" Then
         MsgBox "En " & locForm & " : Impossible de trouver une cellule sur le critère : (" & LeTest & LaValeur & ") dans l'onglet [" & LeRange.Worksheet.Name & "] et la zone " & LeRange.Address, Buttons:=vbCritical, Title:="Aucune Cellule Trouvée"
      End If
    End If
  End If
  '
End Function