Bonjour,
La Fonction Find sur des dates est très particulière ...
Il m'aura fallu du temps pour comprendre le [ handle ] de la situation ...
Appel à partir d'une fonction : Méthode Find telle qu'elle s'applique à l'objet WorksheetFunction.
Appel à partir d'une routine : Méthode Find telle qu'elle s'applique à l'objet Range
Ici, c'est le deuxième qui est utilisé, au moment de lancer la commande Find, Excel ne doit pas
être dans une fonction étrangement mais dans une procédure, je vous suggère de procéder
comme suit :
Une fonction personnalisé :
Public Function ChercheDateFonction(ByVal Cellule As Range) As Long
Une procédure globale disponible sous menu/bouton
Public Sub ChercheDateRoutine
Une sous procédure privée commune :
Private Sub ChercheDateSousRoutine
et en exemple, une seconde procédure globale de recherche.
Option Explicit
'
Private Sub ChercheDateSousRoutine(ByRef Resultat As Long, ByVal Cellule As Range)
Dim PlageDeRecherche As String, CelluleTrouve As Range
Resultat = 0
PlageDeRecherche = "A7:A" & Range("A7").End(xlDown).Row
With Range(PlageDeRecherche)
Set CelluleTrouve = .Find(What:=Cellule.Value, LookIn:=xlValues)
End With
If Not (CelluleTrouve Is Nothing) Then
Resultat = CelluleTrouve.Row
Else
Resultat = 0
End If
Set CelluleTrouve = Nothing
End Sub
'
Public Sub ChercheDateRoutine()
Dim varRetour As Long
Dim VarCellule As Range
Range("H7").Select: varSoluce = 0
While (ActiveCell.Offset(0, 2).Value <> "")
Set VarCellule = ActiveCell.Offset(0, 2)
ChercheDateSousRoutine varRetour, VarCellule
If (varRetour > 0) Then
ActiveCell.Offset(0, 0).Value = varRetour
Else
ActiveCell.Offset(0, 0).Value = "Nil"
End If
ActiveCell.Offset(1, 0).Select
Wend
Range("A6").Select
End Sub
'
Public Function ChercheDateFonction(ByVal Cellule As Range) As Long
Application.Volatile
ChercheDateSousRoutine ChercheDateFonction, Cellule
End Function
'
Public Sub Recherche()
Dim VarChaine As String, VarLigne As Long
Dim VarCellule As Range
VarChaine = CStr(Application.InputBox("Cellule source : ", Type:=8).Value)
With Range("A7:A14")
Set VarCellule = .Find(What:=VarChaine, LookIn:=xlValues)
End With
If Not (VarCellule Is Nothing) Then
VarLigne = VarCellule.Row
Else
VarLigne = 0
End If
MsgBox VarLigne & vbLf & VarCellule.Address
Set VarCellule = Nothing
End Sub
'
Lupin
