|
|
|
|
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
Function TrouveDate2(str As String)
TrouveDate2 = TrouveDate(str, ActiveSheet)
End Function
Configuration: Windows XP Internet Explorer 6.0
Bonjour,
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,
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 |