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

[fanch69]

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

 

[Hasco]

Bonjour,

Si votre macro localise la ligne pour surligner l'élève il vous suffit d'ajouter:

Application.Goto Sheets("LaFeuille").Range("A" & Ligne)

Où Ligne est le numéro de ligne trouvé par votre macro.

Sans plus de précision difficile de vous indiquer autre chose.

A vous relire

 

[fanch69]

merci de votre réponse, mais cela ne fonctionne pas.
Ci joint ma macro (que je n'ai pas créé, mais adapté de tutoriels que j'ai trouvé sur le net, n'étant pas un expert :
Private Sub TextBox1_Change()

Application.ScreenUpdating = False

Range("A6:A2000").Interior.ColorIndex = 2 'Exemple 1 (feuille)


If TextBox1 <> "" Then
For Ligne = 6 To 2000
If Cells(Ligne, 1) Like "*" & TextBox1 & "*" Then
Cells(Ligne, 1).Interior.ColorIndex = 43 'Exemple 1 (feuille)
Application.Goto Sheets("Suivi élèves").Range("A" & Ligne) 'votre ligne que j'ai rajouté

End If
Next
End If

End Sub

Cordialement,
M. PERRIN

 

[martineau]

au debut de votre macro vous avez la ligne application.screenupdating=false qui désactive le rafraichissement de votre feuille, il faut rajouter après la dernière ligne end if la ligne suivante application.screenupdating=true ainsi votre feuille sera mise a jour et vous serez positionné sur la ligne

 

[fanch69]

Bonjour,

Merci de votre réponse.

Puisque vous avez l'air de maîtriser le sujet, puis je encore vous solliciter ? Si ce n'est pas trop compliqué à mettre en place, et que cela ne vous prenne pas trop de temps de réflexion ...
Voilà si je recherche un élève qui se nomme Vernay. Que je tape dans ma recherche Ver, ma macro me propose tous les noms possédant la casse Ver, donc elle va me proposé par exemple entre autre Favergeat .. Comment faire pour faire une recherche lettre par lettre, en commençant par le début (je ne sais pas si le terme est exacte) ?

Cordialement,
M. PERRIN

 

[martineau]

autant pour moi, il faut rajouter la ligne suivante sous votre ligne cells(ligne,1).interior…..
Cells(ligne, 1).Activate

 

[fanch69]

Cells(ligne, 1).Activate

Merci de votre réponse, mais maintenant dès que je tape F, ma macro va au début des élèves en F et si je veux rentrer un autre caractère comme le a de Fa (favergeat) cela m'efface le nom sélectionné, et le remplace par a ..
Cordialement

 

[martineau]

pour votre deuxième demande, votre test if cells(ligne,1) like "*" & textbox1 & "*" then recherche les cellules contenant l'expression textbox1 car vous avez "*" & texbox1 & "*" en retirant le "*" & avant texbox1 vous allez rechercher uniquement les cellules dont le contenu commence par textbox1, cela devrait répondre à votre demande si j'ai bien compris celle-ci

 

[martineau]

pouvez vous me joindre votre fichier pour que je fasse une analyse

 

[fanch69]

pouvez vous me joindre votre fichier pour que je fasse une analyse

merci j'avais trouvé pour la recherche sur le début du nom. Mais merci de me conforter dans ma logique.
Je vous envoie mon fichier.

Cordialement

M. PERRIN

 

[martineau]

voici la version qui répond a votre demande

 

[patricktoulon]

bonjour

scroll ton find(row)

Private Sub TextBox1_Change()

    Dim Plage As Range, c As Range
    Set Plage = ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Plage.Resize(, 11).Interior.ColorIndex = 2   'Exemple 1 (feuille)
    ActiveWindow.ScrollRow = 1
    If TextBox1 <> "" Then
        With Plage
            Set c = .Find(TextBox1.Value, lookat:=xlPart)
            If Not c Is Nothing Then
                If Left(Trim(c.Text), Len(TextBox1)) = TextBox1 Then
                    ActiveWindow.ScrollRow = c.Row
                    c.MergeArea.Resize(, 11).Interior.Color = vbGreen
                End If
            End If
        End With
    End If


End Sub

après pour être honnête je sais pas pourquoi ca ne fonctionne qu'a partir de 3 eme caractère
mais bon la ligne cherchée se retrouve toujours en première position c'est plus simple visuellement

 

[patricktoulon]

re
bonjour Martineau
selon ton modèle mais avec le scrollRow
et la plage est délimitée par ce qui est rempli et non en dur (11/2000)
les cellules trouvée se retrouvent toujours en haut c'est plus pratique non?
et c'est la ligne complète(fusion compris) qui est en couleur
donc pour une éventuelle modif ' dans une colonne la encore c'est plus facile visuellement sachant qu'il peut y avoir plusieurs lignes pour un élève puisque plusieurs classe

Option Compare Text


Private Sub TextBox1_Change()
    Dim Plage As Range, c As Range
    Set Plage = ActiveSheet.Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Plage.Resize(, 11).Interior.ColorIndex = 2   'Exemple 1 (feuille)
    ActiveWindow.ScrollRow = 1
    l = 0
    If TextBox1 <> "" Then
        For Each cel In Plage.Cells
            If cel Like TextBox1 & "*" Then
                If l = 0 Then l = cel.Row
                cel.MergeArea.Resize(, 11).Interior.ColorIndex = 43    'Exemple 1 (feuille)
            End If
        Next
        If l <> 0 Then ActiveWindow.ScrollRow = l
    End If
    Application.ScreenUpdating = True
End Sub

 

[fanch69]

Merci de vos réponses

 

[Hasco]

Bonjour,

Dans le fichier joint vous trouverez une méthode sans boucle. C'est un nom définit et une MFC qui prend en charge le changement de couleur de la cellule trouvée.

Private Sub TextBox1_Change()
    Dim idx As Variant: idx = CVErr(xlErrNA)
    If TextBox1 <> "" Then idx = Application.Match(TextBox1.Text & "*", Range(Cells(10, 1), Cells(Rows.Count, 1).End(xlUp)), 0)
    If Not IsError(idx) Then
        ThisWorkbook.Names.Add "Position_Trouvée", 9 + idx
        Application.Goto Cells(9 + idx, 1), True
    Else
        ThisWorkbook.Names.Add "Position_Trouvée", 0
        Application.Goto Cells(10, 1), True
    End If
End Sub