A voir également:
- Formulaire de recherche VBA-Excel
- Liste déroulante excel - Guide
- Formulaire de réclamation facebook - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Si et excel - Guide
- Word et excel gratuit - Guide
1 réponse
Utilisateur anonyme
24 mars 2008 à 13:11
24 mars 2008 à 13:11
Bonjour,
Voici un exemple que j'avais codé pour un membre CCM.
Postulat :
Les critères de recherche sont sur la feuille 1
Les données index sont sur la feuille 2
Lupin
Voici un exemple que j'avais codé pour un membre CCM.
Postulat :
Les critères de recherche sont sur la feuille 1
Les données index sont sur la feuille 2
Option Explicit ' Type Resultats Ligne As Long Adresse As String Formule As String Valeur As Variant End Type ' Public Sub Recherche() Dim varCellule As Range, VarChaine As String Dim VarBoite As Resultats VarBoite.Ligne = 0: VarBoite.Adresse = "": VarBoite.Valeur = "" Set varCellule = Application.InputBox("Cellule source : ", Type:=8) Sheets(2).Select Range("A1").Select ChercheDateSousRoutine VarBoite, varCellule VarChaine = "" VarChaine = vbLf & " { - - - Paramètres trouvés en fonction de la recherche - - - } " & vbLf & vbLf VarChaine = VarChaine & vbLf & "[ Ligne : " & VarBoite.Ligne & " ] " & vbLf VarChaine = VarChaine & vbLf & "[ Adresse : " & VarBoite.Adresse & " ] " & vbLf VarChaine = VarChaine & vbLf & "[ Formule : " & VarBoite.Formule & " ] " & vbLf VarChaine = VarChaine & vbLf & "[ Valeur : " & VarBoite.Valeur & " ] " & vbLf VarChaine = VarChaine & vbLf & vbLf MsgBox VarChaine, vbOKOnly, "Recherche personnalisé" Set varCellule = Nothing End Sub ' Private Sub ChercheDateSousRoutine(ByRef VarBte As Resultats, ByVal Cellule As Range) Dim PlageDeRecherche As String, CelluleTrouve As Range PlageDeRecherche = "A1: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 VarBte.Formule = CelluleTrouve.Formula VarBte.Valeur = CelluleTrouve.Value Else VarBte.Ligne = 0 End If Set CelluleTrouve = Nothing End Sub '
Lupin