Discussion :

[croky23]

Bonjour le forum
Dans une colonne , j'ai sur chaque ligne un intitulé composé de plusieurs mots.
Je voudrai avec une fonction recherche en entrant un seul mot ouvrir une boite avec tout les intitulés comprenant ce mot
pouvez vous m'aider
merci

[mercatog]

une 1ère proposition

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
Dim lastlig As Long, i As Long, j As Long
Dim mot As String
Dim c As Range
Dim tablo() As String
 
lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
mot = InputBox("Mot cherché")
mot = "*" & mot & "*"
ReDim tablo(1)
j = 0
 
For Each c In Range("A1:A" & lastlig)  'à adapter
    If c.Value Like mot Then
        tablo(j) = c.Value
        c.Interior.ColorIndex = 4
        ReDim Preserve tablo(UBound(tablo) + 1)
        j = j + 1
    End If
Next c
For i = 0 To UBound(tablo)
    Range("C" & i + 1) = tablo(i)
Next i

mais attention, à la recherche du mot "mat", il trouve mathématique, Fermat, matinale...

voir aussi plus rapide "??": .Find et .FindNext

[croky23]

Merci pour cette réponse mais je n'arrive pas à l'adapter
je vas essayer de joindre mon classeur
Je voudrai inserer le code dans le commanbutton rechercher
merci

[helas]

Bonjour,
il faut mettre le bouton en mode création (icone representant une equerre) puis faire un clic droit et cliquer visualiser le code
l'evenement Private Sub CommandButton1_Click() se crée automatiquement
Il suffit ensuite d'insérer le code de mercatoq

[mercatog]

Je viens de l'adapter à ton fichier exemple
les résultats sont copiés dans ta feuille2

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 CommandButton1_Click()
Dim lastlig As Long, i As Long, j As Long
Dim mot As String
Dim c As Range
Dim tablo() As String
 
lastlig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
mot = InputBox("Mot cherché")
mot = "*" & mot & "*"
ReDim tablo(1)
j = 0
 
For Each c In Range("B2:B" & lastlig)  'à adapter
    If c.Value Like mot Then
        tablo(j) = c.Value
        c.Interior.ColorIndex = 4
        ReDim Preserve tablo(UBound(tablo) + 1)
        j = j + 1
    End If
Next c
Sheets("Feuil2").Columns("A:A").ClearContents
For i = 0 To UBound(tablo)
    Sheets("Feuil2").Range("A" & i + 1) = tablo(i)
Next i
End Sub

Par contre si tu chercherai C.A. il te sortira: .P.A C.A.T, C.A.T, ...
si tu veux que le résultat soit seulement C.A.T, il faudra ajouter d'autres tests

[croky23]

merci

encore un petit soucis

la ou les phrases selectionnées en vert restent en vert ,comment puis je faire pour que des que je vais faire une nouvelle recherche cela enleve la couleur ?

Et je dois respecter la casse pour que cela marche , et je voudrai trouver les mots qu'ils soient en minuscule ou en majuscule

merci

[mercatog]

enlève cette ligne

Code :

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

        c.Interior.ColorIndex = 4

je l'ai ajouté pour tester
tes case ne seront plus coloriés
Oui effectivement, ça respect la casse (par défaut) sauf changement de Option Compare

ou bien décolorer avant
ajouter cette ligne

Code :

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

1
2
3
ReDim tablo(1)
j = 0
Range("B2:B" & lastlig).Interior.ColorIndex = xlNone  'CETTE LIGNE A AJOUTER