[VBA Excel] Recherche de date qui déconne ...

Bonjour
C'est normal qu'lle marche mais c'est bizare
Pourquoi appelle tu TrouveDate2 dans TrouveDate2??
J'ai l'impression que cela devrait tourner en boucle cette histoire, voire meme ne pas fonctionner puisque tu appele TrouveDate2 avec un argument en trop

Non désolé y avait une erreur j'avais pas fait gaffe
Quand tu dis que ca ne marche plus par un sub, que se produit il exactement??

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

Bonjour,

voici une variante :-)

Option Explicit
'
Type Resultats
        Ligne As Long
        Adresse As String
        Valeur As Variant
End Type
'


Private Sub ChercheDateSousRoutine(ByRef VarBte As Resultats, _
                                   ByVal Cellule As Range)

    Dim PlageDeRecherche As String, CelluleTrouve As Range

    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
        VarBte.Ligne = CelluleTrouve.Row
        VarBte.Adresse = CelluleTrouve.Address
    Else
        VarBte.Ligne = 0
    End If
    Set CelluleTrouve = Nothing
    
End Sub
'

Public Sub ChercheDateRoutine()

    Dim Boite As Resultats, VarCellule As Range
        
    Range("H7").Select
    While (ActiveCell.Offset(0, 2).Value <> "")
        Set VarCellule = ActiveCell.Offset(0, 2)
        ChercheDateSousRoutine Boite, VarCellule
        If (Boite.Ligne > 0) Then
            ActiveCell.Offset(0, 0).Value = Boite.Ligne
        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
    
    Dim Bloc As Resultats
    
    Application.Volatile
    Bloc.Ligne = 0: Bloc.Adresse = "": Bloc.Valeur = Null
    ChercheDateSousRoutine Bloc, Cellule
    ChercheDateFonction = Bloc.Ligne
    
End Function
'

Public Sub Recherche()
    
    
    Dim VarChaine As String, VarBoite As Resultats
    Dim VarCellule As Range, VarAdresse As String
    
    VarBoite.Ligne = 0: VarBoite.Adresse = "": VarBoite.Valeur = ""
    Set VarCellule = Application.InputBox("Cellule source : ", Type:=8)
    Range("A6").Select
    ChercheDateSousRoutine VarBoite, VarCellule
    MsgBox VarBoite.Ligne & vbLf & VarBoite.Adresse
    Set VarCellule = Nothing
    
End Sub
'

Lupin

Merci pour votre aide ca marche nickel !