XL 2016 Sélection de cellules suite à recherche par VBA

Webperegrino

XLDnaute Impliqué
Supporter XLD
Bonjour Le Forum,
Dans le fichier ci-joint, j'ai placé deux macros.
Celle qui m'indique la lettre de la colonne, selon son n° entré dans le message, fonctionne bien et me convient.

La deuxième macro me pose souci dans la mesure où le contenu de la cellule F15 n'est pas traitée, puis sélectionnée suite à une recherche sur les prénoms LUCIE ou JEAN.
Quant à demander avec MARCEL ou CELINE, c'est encore plus désastreux comme résultat...

Le top, en bonus de conception : la fin de cette macro pourrait fonctionner suivant l'inverse de la première, pour indiquer en message les références des cellules où se positionne le prénom recherché.
Peut-être auriez-vous une proposition ?
Cordialement,
Webperegrino
 

Pièces jointes

  • RECHERCHER_UN_MOT.xlsm
    23.3 KB · Affichages: 8

patricktoulon

XLDnaute Barbatruc
bonjour à tout les deux
1° je mettrais éventuellement en haut de module option compare text
pour ne pas être obliger de taper en majuscule

2° et pour ne pas charger la memoire avec une variable string
dans le message de resultat j'utiliserais Pl.Address(0, 0)

3° à utiliser un Goto ---> fin:
autant s'en servir et déclencher un message avec la description de l'erreur
ainsi qu'un goto 0 histoire de vider le stack de gestion d'erreur


VB:
Sub MacroMOT()
    Dim Cel As Range
    Dim Pl As Range
    Dim Prenom$
       On Error GoTo Fin
Prenom = InputBox("Indiquez le PrŽnom recherchŽ")
    If Prenom = "" Then Exit Sub
    For Each Cel In Cells.SpecialCells(xlCellTypeConstants)
        If Cel.Value Like "*" & Prenom & "*" Then
            If Pl Is Nothing Then
                Set Pl = Cel
            Else
                Set Pl = Application.Union(Pl, Cel)
             End If
        End If
    Next Cel
    Pl.Select
    If Not Pl Is Nothing Then
        MsgBox "Ref trouvees pour : " & Prenom & vbCrLf & vbTab & Pl.Address(0, 0)
    Else
        MsgBox "Pas trouvee de Ref pour : " & Prenom & " ! "
    End If
Fin:
if err.number  then MsgBox "une erreur c'est produite dans la requête" & vbCrLf & err.description
on error goto 0
End Sub

et si l'option compare text peut etre problématique pour d'autre sub ou fonctions dans le module
et bien on l’enlève et on change le test like dans la sub pour instr + vbTextCompare
VB:
Sub MacroMOT()
    Dim Cel As Range
    Dim Pl As Range
    Dim Prenom$
       On Error GoTo Fin
     Prenom = InputBox("Indiquez le PrŽnom recherchŽ")
    If Prenom = "" Then Exit Sub
    For Each Cel In Cells.SpecialCells(xlCellTypeConstants)
        If InStr(1, Cel.Value, Prenom, vbTextCompare) Then
            If Pl Is Nothing Then
                Set Pl = Cel
            Else
                Set Pl = Application.Union(Pl, Cel)
             End If
        End If
    Next Cel
    Pl.Select
    If Not Pl Is Nothing Then
        MsgBox "Ref trouvees pour : " & Prenom & vbCrLf & vbTab & Pl.Address(0, 0)
    Else
        MsgBox "Pas trouvee de Ref pour : " & Prenom & " ! "
    End If
Fin:
If Err.Number Then MsgBox "une erreur c'est produite dans la requête" & vbCrLf & err.description
On Error GoTo 0
End Sub

on pourrait aussi simplement faire une recherche multi prénom si vous voulez
;)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 211
Messages
2 086 299
Membres
103 172
dernier inscrit
Aurelyan