Microsoft 365 Creer un bouton VBA pour lancer une recherche

[hanGOUP]

Bonjour,

Je souhaite creer un code VBA :

Adroite de mon tableau :
une zone de texte pour saisir la ref recherché
un bouton recherche

Mon tableau Excel comporte 5 colonnes :
Reference
Emplacement
Montage
Outils
Commentaire

Merci pour votre ide

 

[sylvanu]

Bonjour Hangoup,
tenez vous au VBA ?
Si non il; est simple de le faire en formule, comme en PJ, avec :

=SIERREUR(RECHERCHEV($H$6;$A$2:$E$45;2;0);"")

Si le VBA est exigé, fournissez un fichier test, cela évitera de nombreux allers retours car le fichier que le contributeur construira sera évidemment différent du votre.

 

[sylvanu]

Re,
"Just for the fun", en PJ :
- Feuil1: une macro sur un bouton avec :

Sub rechercher()
If [H5] = "" Then Exit Sub
Dim Réf, L%
Réf = [H5]
[I5:L5].ClearContents
If Application.CountIf([A:A], Réf) > 0 Then
    L = Application.Match(Réf, [A:A], 0)
    [H5:L5] = Range("A" & L & ":L" & L).Value
End If
End Sub

- Feuil2: une macro événementielle. il suffit de modifier la valeur de la cellule en jaune pour mettre à jour, avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [H5]) Is Nothing Then
        If Target = "" Then Exit Sub
        Dim L%
        [I5:L5].ClearContents
        If Application.CountIf([A:A], Target) > 0 Then
            L = Application.Match(Target, [A:A], 0)
            [H5:L5] = Range("A" & L & ":L" & L).Value
        End If
    End If
Fin:
End Sub

 

[hanGOUP]

Re,
"Just for the fun", en PJ :
- Feuil1: une macro sur un bouton avec :

Sub rechercher()
If [H5] = "" Then Exit Sub
Dim Réf, L%
Réf = [H5]
[I5:L5].ClearContents
If Application.CountIf([A:A], Réf) > 0 Then
    L = Application.Match(Réf, [A:A], 0)
    [H5:L5] = Range("A" & L & ":L" & L).Value
End If
End Sub

- Feuil2: une macro événementielle. il suffit de modifier la valeur de la cellule en jaune pour mettre à jour, avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [H5]) Is Nothing Then
        If Target = "" Then Exit Sub
        Dim L%
        [I5:L5].ClearContents
        If Application.CountIf([A:A], Target) > 0 Then
            L = Application.Match(Target, [A:A], 0)
            [H5:L5] = Range("A" & L & ":L" & L).Value
        End If
    End If
Fin:
End Sub

Bonjour,
Merci pour votre réponse rapide.

c'est plutôt bien
Merci bcp pour votre aide