XL 2021 comment faire recherche dans une colonne et ligne

Nico77 · 4 Septembre 2024

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

Nico77 · 5 Septembre 2024

sousou à dit:
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...

sousou · 4 Septembre 2024

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 · 5 Septembre 2024

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 :

VB:

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 · 5 Septembre 2024

sousou à dit:
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 · 5 Septembre 2024

job75 à dit:

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 :

VB:

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 · 5 Septembre 2024

Nico77 à dit:
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 :

VB:

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.

XL 2021 comment faire recherche dans une colonne et ligne

Nico77

XLDnaute Nouveau

Pièces jointes

Nico77

sousou

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Nico77

XLDnaute Nouveau

Nico77

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires