Discussion :

[saninx]

j'ai observé une macro de recherche sur le net que j'ai essayé d'appliquer à mon cas, ce qui donne le programme suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
    Private Sub TextBox1_Change()
 
    Dim nbligne As Long
    Dim cellul As Long
 
    Application.ScreenUpdating = False
    Range("B2:B27").Interior.ColorIndex = 2
 
    nbligne = 1
    cellul = 2
    While Cells(cellul, 2) <> ""
        cellul = cellul + 1
        nbligne = nbligne + 1
    Wend
 
    If TextBox1 <> "" Then
    For ligne = 2 To nbligne
        If Cells(ligne, 2) Like "*" & TextBox1 & "*" Then
           Cells(ligne, 2).Interior.ColorIndex = 43
        End If
    Next
    End If
        'TextBox1 = ""
        'MsgBox ("Aucun enregistrement ne correspond à cette recherche")
End Sub

Cependant j'aimerais que lorsqu'il ne reste qu'une seule cellule en vert, la fenêtre descende sur la ligne correspondante dans le cas ou celle-ci n'est pas visible avec l'option "ActiveWindow.SmallScroll" et si pour finir aucune recherche n'est trouvée, le signaler à l'utilisateur.

ci-joint vous trouverai l'image de ma recherche.

[gnain]

Bonjour,
Votre code pourrait être amélioré.

Premièrement j'ai remarqué que vous placer au début de votre code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

il ne faut pas oublier de le remettre à True à la fin car la feuille ne se mettra plus à jour.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = true

Deuxièmement vous passer par une boucle While pour savoir le nombre de ligne pour ensuite
vous faites une boucle for, vous pouvez combiné les deux en fessant ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For ligne = 2 To Range("B" & Rows.Count).End(xlUp).Row

Range("B" & Rows.Count).End(xlUp).Row = dernière ligne non vide à partir du bas

Pour que excel se positionne sur le dernier trouvé il faut activé la cellule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(ligne, 1).Activate

Si aucun enregistrement trouvé il faut passer une variable boolean à true
ensuite avec une condition variable boolean = False on fait apparaître un msgbox

voici le code complet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub TextBox1_Change()
 
    Dim Trouvé As Boolean
 
    Trouvé = False
 
    Application.ScreenUpdating = False
    Range("B2:B27").Interior.ColorIndex = 2
 
       If TextBox1 <> "" Then
        For ligne = 2 To Range("B" & Rows.Count).End(xlUp).Row
            If Cells(ligne, 2) Like "*" & TextBox1.Text & "*" Then
               Cells(ligne, 2).Interior.ColorIndex = 43
               Cells(ligne, 2).Activate
               Trouvé = True
            End If
        Next
    End If
 
    Application.ScreenUpdating = true
 
    If Trouvé = False Then MsgBox "Aucune recherche n'a été trouvé"
 
End Sub

[gFZT82]

Bonjour,

Tu peux également utiliser la méthode Range.Find pour la recherche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
Private Sub TextBox1_Change()
Dim DerLig As Long
Dim C As Range
Dim FirstAddress As String
Dim Cptr As Integer
    Application.ScreenUpdating = False
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    Range("B2:B" & DerLig).Interior.ColorIndex = 2
    If TextBox1 <> "" Then
        Set C = Range("B2:B" & DerLig).Find(TextBox1.Value, , xlValues, xlPart)
        If Not C Is Nothing Then
            FirstAddress = C.Address
            Do
                C.Interior.ColorIndex = 43
                Cptr = Cptr + 1
                Set C = Range("B2:B" & DerLig).FindNext(C)
            Loop While Not C Is Nothing And C.Address <> FirstAddress
            Set C = Range("B2:B" & DerLig).Find(TextBox1.Value, , xlValues, xlPart)
            If Cptr = 1 Then
                ActiveWindow.ScrollColumn = Application.Max(1, C.Column - ActiveWindow.VisibleRange.Columns.Count / 2)
                ActiveWindow.ScrollRow = Application.Max(1, C.Row - ActiveWindow.VisibleRange.Rows.Count / 2)
                C.Select
            End If
        Else
            MsgBox "Le texte recherché n'est pas dans la liste", vbExclamation
            TextBox1.Value = Left(TextBox1.Value, Len(TextBox1.Value) - 1)
        End If
    End If
    Set C = Nothing
End Sub

Cordialement.

[saninx]

Merci à tous pour vos solution,

gFZT82 ta macro est impeccable. pour ceux que sa intéresserait veuillez vous en inspirer