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

Question

Bonjour, 

j'ai un problème dans VBA pour excel.
J'ai créé une fonction pour me trouver la ligne d'une dans une liste.
Quand j'appelle la fonction par une autre fonction. Ca marche. Quand je l'appelle par un sub ça ne marche plus !

Voilà le code

Public Function TrouveDate(str As String, ws As Worksheet) As Long

  'la colonne dans laquelle on va faire de la recherche
    Dim premierecolonne As Range
    'la case trouvée
    Dim caseTrouvee As Range
    
    
    
    
    Set premierecolonne = ws.Range("A7", ws.Range("A7").End(xlDown))
   
    
    Set caseTrouvee = premierecolonne.Find(what:=Format(CDate(str), "mm/yyyy"), LookIn:=xlFormulas)
    
    
    If (Not caseTrouvee Is Nothing) Then
        TrouveDate = caseTrouvee.Row
    Else
        TrouveDate = 0
    End If
   

End Function


et la fonction appelante qui marche

Function TrouveDate2(str As String)
    TrouveDate2 = TrouveDate(str, ActiveSheet)
End Function


Les arguments de trouveDate sont bons. J'en suis certain. Je recherche bien dans la bonne feuille.
Les données sont consistantes aussi !
Des idées ?

freto · Answer

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

freto · Answer

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??

Utilisateur anonyme · Answer

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

Utilisateur anonyme · Answer

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

Chuck · Answer

Merci pour votre aide ca marche nickel !

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

5 réponses

Discussions similaires