Attribute VB_Name = "Position_Premier_v121" '---------------------------------------------------------------------------------------- ' Procédure_____: Position_Premier ' Date__________: 26/10/2021 ' 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, Optional LeType, Optional LeTest, Optional PasdInfo) ' Retour________: Adresse, N° de ligne ou N° de colonne (cells), 0 ou ! en cas d'erreur ' Options_______: Si LeType := "LetCol", retourne les Lettres de Colonne uniquement ' Options_______: Si LeType := "NumCol", retourne le Numéro de Colonne uniquement ' Options_______: Si LeType := "NumLig", retourne le Numéro de Ligne uniquement ' Options_______: Si LeTest := "<=", ">=" ,"<>" (par défaut recherche exacte "=") ' Options_______: Si PasdInfo := true, n'Affiche pas de message si non trouvé ' 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 Ajoute une option de test basique (/!\ en paramètre avant celui de PasdInfo) ' 2021.10.26 v1.21 Ajout de précisions dans la gestion des erreurs (lieu de la formule, test appliqué, valeur retournée) ' Function Position_Premier(LaValeur As Variant, LeRange As Range, Optional LeType As String, Optional LeTest As String, Optional PasdInfo As Boolean) As Variant ' ' Note : 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 For Each c In LeRange valTest = False If LeTest = Empty Then LeTest = "=" ' Combinaison de Tests If c.Value <> "" 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 "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 "" ' Choix par Défaut Position_Premier = c.Address 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 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