Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 afficher une ligne précise après recherche par macro

fanch69

XLDnaute Nouveau
Bonjour,

Nous avons un fichier de suivi d'élèves, contenant sa scolarité précédente, ses problèmes etc.
La personne qui l'a créé, a classer les élèves par ordre alphabétique.
Donc, quand on veut modifier des informations sur un élèves, c'est long à chercher.
J'ai créé une sorte de macro me permettant de rechercher et de surligner l'élève que l'on cherche.
Seulement à 99% des cas, la ligne est loin. Bon ok, elle est en vert, donc visible.
Mais j'aimerai savoir si en complétant ma macro, je ne pourrai pas afficher directement la ligne de l'élève à l'écran, positionner le curseur sur celle-ci.

Par avance merci de vos réponse,
Cordialement,
M. PERRIN
 

patricktoulon

XLDnaute Barbatruc
re
soyons fous
VB:
Private Sub TextBox1_Change()
   Set p = ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp))
    p.Interior.Color = xlNone
  
    If TextBox1 <> "" Then
        If Not IsError(Evaluate("=MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & ",A1:A2000,1,0),A1:A2000,0)")) Then
            ligne = (Evaluate("=MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & ",A1:A2000,1,0),A1:A2000,0)"))
            Cells(ligne, "A").Interior.ColorIndex = 43
            ActiveWindow.ScrollRow = ligne
        End If
    End If
'ps: je n'ai pas réussi a intégrer dans la formule évaluée le p.address(0,0)
End Sub


voila qui est fait
Code:
Private Sub TextBox1_Change()
    p = ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp)).Address(0, 0)
    Range(p).Interior.Color = xlNone
   
    If TextBox1 <> "" Then
        If Not IsError(Evaluate("=MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)," & p & ",0)")) Then
            ligne = Evaluate("=MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)," & p & ",0)")
            Cells(ligne, "A").Interior.ColorIndex = 43
            ActiveWindow.ScrollRow = ligne
        End If
    End If
End Sub

si le coeur vous en dit et la je m'adresse au crack en formule
je souhaiterais bien gérer l'erreur en interne dans la formule pour me passer de la répétition textuelle du code donc je suppose inclure "sierreur"
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
oui il faut utiliser ce que l'on comprends ne serait ce que pour debuguer soit même en cas de pépins
sinon perso voila la gestion d'erreur interne dans le evaluate

VB:
Private Sub TextBox1_Change()
    p = ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp)).Address(0, 0)
    Range(p).Interior.Color = xlNone
    ActiveWindow.ScrollRow = 1
    ligne = Evaluate("=IFERROR(MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)," & p & ",0),0)")
    If ligne > 0 Then
        Cells(ligne, "A").Interior.ColorIndex = 43
        ActiveWindow.ScrollRow = ligne
    End If
End Sub
remarquez que le test de la valeur vide du textbox est absente cette fois ci
la formule évaluant a 0 dans tout les cas ou aucune correspondance ça n'est plus nécessaire

explication:

ligne = Evaluate("=IFERROR(MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)," & p & ",0),0)")

p--->contient l'adresse des cellules utilisées dans la colonne A en occurrence dans le cas présent A1:A1554

VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)
---> (RECHERCHEV) trouve le premier nom qui débute par textbox1.value ou erreur (N/A)

MATCH(VLOOKUP(""" & TextBox1.Value & "*""" & "," & p & ",1,0)," & p & ",0)--->(EQUIV) renvoie la ligne trouvé ou déclenche une erreur

IFERROR(.......,0)---> renvoie 0 si vlookup ou match déclenche une erreur

evaluate ---> fonction vba pour dans le cas présent sert à récupérer le résultat d'une formule (sert aussi a Evaluer une expression)

la meme formule écrite dans une cellule donnerait donc par exemple ceci
on recherche le premier nom commençant par "gui"

=SIERREUR(EQUIV(RECHERCHEV("gui*";A1:A1554;1;0);A1:A1554;0);0)
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…