XL 2010 Macro double recherche

[noel33]

Bonjour à tous,

petite recherche du Dimanche:

J'ai trouvé, a force de recherche, deux macro :

Une qui me recherche dans une colonne une valeur donnée et se positionne dessus,

L'autre qui me recherche sur une ligne la date actuelle.


Ma demande:

Fusionner les deux: Quand je recherche une donnée, je veux que l'on se positionne sur la case qui croise et la valeur donnée, et la date actuelle.


Je vous ai joint un petit fichier qui possède Les deux macros.


D'avance, merci de votre aide!


N.

 

[Hieu]

Salut,

Ton fichier ne contient pas de macro (il faut enregistrer en *.xlsm).

Pour ce que tu veux faire, pas besoin de macro :

=INDEX(C3:AT202;EQUIV(A1;B3:B202;0);EQUIV(B1;C2:AT2;0))

J'ai sinon fait une macro, si c'est pour se positionner dans la cellule :

Sub mlk()
Set WF = WorksheetFunction
lig = WF.Match(Range("a1"), Range("b:b"), 0)
col = WF.Match(Range("b1"), Range("2:2"), 0)
Cells(lig, col).Select
End Sub

 

[noel33]

voila le fichier avec les deux macros

 

[Hieu]

Re,

En mergeant les deux macros :

Sub recherche()
Dim rngTrouve As Range
Dim strChaine As Integer
Dim d As Date
d = Date

strChaine = InputBox("Numéro MSN à Chercher :")
Set rngTrouve = ActiveSheet.Columns(2).Cells.Find(what:=strChaine)
Set obj = Rows(2).Find(d, , , xlWhole)

If rngTrouve Is Nothing Or obj Is Nothing Then
MsgBox "Pas trouvé"
Else
lig = rngTrouve.Row
col = obj.Column
Cells(lig, col).Select
End If

Set rngTrouve = Nothing
End Sub

 

[noel33]

Extra, cela marche, néanmoins:

Si je close la fenêtre, j'ai un bug macro, et si je ne met rien et que je clique sur OK, j'ai également un bug macro.

Je sais, je suis pénible ....


N.

 

[Hieu]

Voilà,

Sub recherche()
Dim rngTrouve As Range
' Dim strChaine As Integer    ' suppression  du forcing en Integer 
Dim d As Date
d = Date

strChaine = InputBox("Numéro MSN à Chercher :")
If Not IsNumeric(strChaine) Then Exit Sub    ' rajout de cette condition
Set rngTrouve = ActiveSheet.Columns(2).Cells.Find(what:=strChaine)
Set obj = Rows(2).Find(d, , , xlWhole)

If rngTrouve Is Nothing Or obj Is Nothing Then
MsgBox "Pas trouvé"
Else
lig = rngTrouve.Row
col = obj.Column
Cells(lig, col).Select
End If

Set rngTrouve = Nothing
End Sub

 

[noel33]

extra !

Merci beaucoup, bonne fin de we!