Macro de recherche a partir d'une meme cellule dont la valeur varie

Bonjour à tous.

Je souhaiterai à partir d'une entree avec douchette dans la cellule B2 rechercher la meme valeur dans la colonne A et me positionner dessus. La cellule B2 variera à chaque entree de douchette

Bonjour,

Une proposition :

Public Sub Trouver()
    Dim derLigne%
    derLigne = Range("A1").End(xlDown).Row
    Range(Range("A1:A" & derLigne).Find(Range("B2").Value).Address).Select
End Sub

merci mais la macro ne fonctionne pas. Je joins un fichier avec une zone de texte explicative pour etre plus claire

5test.xlsm (15.53 Ko)

Salut ferran,

Salut Oyobrans,

plutôt avec Worksheet_Change, non?

Jamais chipoté avec des douchettes non plus, à part dans ma salle de bain...

Tu es sûr de [B2], hein? parce que je vois [B1] coloré!!

Private Sub Worksheet_Change(ByVal Target As Range)
'
On Error Resume Next
If Not Intersect(Target, [B2]) Is Nothing Then
    iRow = Range("A:A").Find(what:=Range("B2").Value, lookat:=xlWhole).Row
    If iRow <> "" Then
        Range("A" & iRow).Offset(0, 1).Select
    Else
        MsgBox "Pas de correspondance!", vbInformation + vbOKOnly, "Info"
    End If
End If
On Error GoTo 0
'
End Sub

A+

2ferran.xlsm (18.79 Ko)

Merci merci !!!! tout fonctionne. effectivement la cellule est bien B1. J'ai adapté le code.

A bientôt

le code fonctionne trés bien mais je n'arrive pas à ajouter l'intruction pour revenir à la cellule b1 aprés une entrée dans la cellule à droite de la cellule recherchée. Quelqu'un peut m'aider ?

Salut ferran,

pas vraiment besoin puisque [B1] réagit elle-même à tout changement en provenance de ta douchette.

Mais, bon, voilà...µ

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Intersect(Target, [B1]) Is Nothing Then
    On Error Resume Next
    iRow = Range("A:A").Find(what:=Range("B1").Value, lookat:=xlWhole).Row
    If iRow <> "" Then
        Range("A" & iRow).Offset(0, 1).Select
    Else
        MsgBox "Pas de correspondance!", vbInformation + vbOKOnly, "Info"
    End If
    On Error GoTo 0
End If
'
If Not Intersect(Target, Range("B:B")) Is Nothing Then [B1].Select
'
End Sub

A+

quand je rajoute cette instruction, la recherche ne se fait plus. En fait aprés la rechercher quand je suis suis sur la cellule à droite de la recherche, je voudrais entrer un valeur et revenir automatiquement par la touche "entrée" dans la cellule B1 pour une nouvelle recherche.

Désolé, j'avais perdu de vue que toutes les données s'affichaient en [B:B]...

Ainsi, c'est mieux?

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    If Target.Row = 1 Then
        On Error Resume Next
        iRow = Range("A:A").Find(what:=Range("B1").Value, lookat:=xlWhole).Row
        If iRow <> "" Then
            Range("A" & iRow).Offset(0, 1).Select
        Else
            MsgBox "Pas de correspondance!", vbInformation + vbOKOnly, "Info"
            [B1] = ""
        End If
        On Error GoTo 0
    Else
        [B1] = ""
        [B1].Select
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Génial tu m'as évité es heures de recherche et peut-être sans résultat.

Merci curulis57

Rechercher des sujets similaires à "macro recherche partir meme valeur varie"