Discussion :

[alidroos]

Bonjour

S'il vous plaît modifier le code suivant

Lorsque vous effectuez une recherche, puis sélectionnez la cellule et sont codés en jaune et quand vous souhaitez effectuer une nouvelle recherche ne cherche pas à pré-coloré

Sur la page de l'événement

Code :

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

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$B$1" Then
If Target.Value = "" Then Exit Sub
A_Ser Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row), Target.Value
End If
End Sub

Ce module

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Public Sub A_Ser(my_r As Range, ByVal S_A As String)
    Dim Rt As Range
    Dim F_A As String
    Dim B_A As Boolean
    Set Rt = my_r
    If Trim(S_A) = "" Then
        Exit Sub
    End If
    With ActiveSheet.Columns(7)
        Set Rt = .Find(S_A, [G1])
        If Not Rt Is Nothing Then
            F_A = Rt.Address
            Do
          Application.Goto Rt, False
         With Range(Rt.Address)
            .Select
            .Interior.Color = 65535
         End With
     If MsgBox("... Click Yes to search for the next record, or not to stop the search ", vbYesNo + vbQuestion, "search?") <> vbYes Then
        B_A = True
          With Range(Rt.Address)
              .Select
              .Interior.Color = 65535
              .AddComment Text:="Search results in this cell"
              .Comment.Visible = True
          End With
            Exit Do
          Else
          With Range(Rt.Address)
               .ClearComments
               .Interior.Color = xlNone
          End With
      End If
            Set Rt = .FindNext(Rt)
           Loop While (Rt.Address <> F_A) And Not (Rt Is Nothing)
       If Not B_A Then
           MsgBox "No other similar values  " & S_A, vbInformation, "search"
          With Range(Rt.Address)
              .Select
              .Interior.Color = 65535
              .AddComment Text:="Search results in this cell"
              .Comment.Visible = True
          End With
        End If
        Else
            MsgBox S_A & " No similar values ??to search...", vbExclamation, "search"
        End If
    End With
End Sub

Fichier attachés