XL 2021 comment faire recherche dans une colonne et ligne

[Nico77]

Bonjour a tous
Voici le code complet, qui fonctionne très bien .
Mais je n'arrive pas a inclure une recherche pour qu'il m'indique uniquement le mot recherché de la colonne A et son code de la colonne D.

Exemple recherche (roue) pour le moment il indique:

6 cellules de roues alors que j'aimerais avoir que celle de la colonne A + son code qui se trouve sur la même ligne mais en colonne D.
Merci

Sub CommandButton_Click()
Sheets("page").Select
reponse = InputBox("mot a chercher :")
Range("A9:A" & Range("A65536").End(xlUp).Row).ClearContents
If reponse = "" Then Exit Sub
Call recherche(reponse)
End Sub


Sub recherche(mot)
Ligne = 3
For Each ws In Sheets
If ws.Name <> "Commande" Then
With ws.Cells
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets("page").Cells(Ligne, 5).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ws.Name & "!" & c.Address, TextToDisplay:=c.Value
Ligne = Ligne + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
trouve = True
End If
End With
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & "mot" & " trouvé dans ce fichier")

End Sub

 

[sousou]

bonjour
modifie ainsi la recherche
Sub recherche(mot)
Ligne = 3
For Each ws In Sheets
If ws.Name <> "Commande" Then
With ws.Columns("a:b").Rows
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets("page").Cells(Ligne, 5).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ws.Name & "!" & c.Address, TextToDisplay:=c.Value

Sheets("page").Cells(Ligne, 6) = c.Offset(0, 2)
Ligne = Ligne + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
trouve = True
End If
End With
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & "mot" & " trouvé dans ce fichier")

End Sub
et le code efface;
Sub effacerListe()
'
Range("E3:f400").Select
Selection.ClearContents
End Sub

 

[job75]

Bonjour Nico77, sousou, le forum,

Pourquoi faire une boucle sur les feuilles puisque seule la feuille "Codes" vous intéresse ?

Voyez cette macro nettement plus simple :

Sub CommandButton_Click()
Dim dest As Range, mot$, P As Range, tablo, i&
Set dest = [E3]
dest.Resize(Rows.Count - dest.Row + 1, 2).Clear 'RAZ
mot = InputBox("Mot a chercher :")
If mot = "" Then Exit Sub
mot = "*" & LCase(mot) & "*"
Set P = Sheets("Codes").UsedRange.Resize(, 4)
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 1)) Like mot Then
        Hyperlinks.Add dest, "", P(i, 1).Address(External:=True), TextToDisplay:=tablo(i, 1)
        dest(1, 2) = tablo(i, 4)
        Set dest = dest(2)
    End If
Next
End Sub

A+

 

[Nico77]

bonjour
modifie ainsi la recherche
Sub recherche(mot)
Ligne = 3
For Each ws In Sheets
If ws.Name <> "Commande" Then
With ws.Columns("a:b").Rows
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Sheets("page").Cells(Ligne, 5).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ws.Name & "!" & c.Address, TextToDisplay:=c.Value

Sheets("page").Cells(Ligne, 6) = c.Offset(0, 2)
Ligne = Ligne + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
trouve = True
End If
End With
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & "mot" & " trouvé dans ce fichier")

End Sub
et le code efface;
Sub effacerListe()
'
Range("E3:f400").Select
Selection.ClearContents
End Sub

Bonjour
Excellent; cela fonctionne a merveille.

Merci fortement

Cordialement
Bonne journée

 

[Nico77]

Bonjour Nico77, sousou, le forum,

Pourquoi faire une boucle sur les feuilles puisque seule la feuille "Codes" vous intéresse ?

Voyez cette macro nettement plus simple :

Sub CommandButton_Click()
Dim dest As Range, mot$, P As Range, tablo, i&
Set dest = [E3]
dest.Resize(Rows.Count - dest.Row + 1, 2).Clear 'RAZ
mot = InputBox("Mot a chercher :")
If mot = "" Then Exit Sub
mot = "*" & LCase(mot) & "*"
Set P = Sheets("Codes").UsedRange.Resize(, 4)
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 1)) Like mot Then
        Hyperlinks.Add dest, "", P(i, 1).Address(External:=True), TextToDisplay:=tablo(i, 1)
        dest(1, 2) = tablo(i, 4)
        Set dest = dest(2)
    End If
Next
End Sub

A+

Bonjour
Merci effectivement.
Mais le doc que j'ai mis en pièce jointe n'est qu'une petite partie de mon dossier.
J'aurais deux boutons un pour les codes et un autre pour les recherches sur plusieurs feuil sauf feuil codes.

Merci pour cette proposition .
Cordialement
Bonne journée

 

[job75]

Mais le doc que j'ai mis en pièce jointe n'est qu'une petite partie de mon dossier.
J'aurais deux boutons un pour les codes et un autre pour les recherches sur plusieurs feuil sauf feuil codes.

Pour la macro du 2ème bouton il faut ajouter une boucle :

Sub CommandButton2_Click()
Dim dest As Range, mot$, w As Worksheet, P As Range, tablo, i&
Set dest = [E3]
dest.Resize(Rows.Count - dest.Row + 1, 2).Clear 'RAZ
mot = InputBox("Mot a chercher :")
If mot = "" Then Exit Sub
mot = "*" & LCase(mot) & "*"
For Each w In Worksheets
    If w.Name <> Me.Name And w.Name <> "Commande" And w.Name <> "Codes" Then
        Set P = w.UsedRange.Resize(, 4)
        tablo = P 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If LCase(tablo(i, 1)) Like mot Then
                Hyperlinks.Add dest, "", P(i, 1).Address(External:=True), TextToDisplay:=tablo(i, 1)
                dest(1, 2) = tablo(i, 4)
                Set dest = dest(2)
            End If
        Next i
   End If
Next w
End Sub

Il faudra peut-être rechercher dans d'autres colonnes.