Discussion :

[declc]

Bonjour,
j'aimerais modifier le code suivant afin que quand il à trouvé une valeur dans une feuille il continue sa recherche sur cette même feuille avant de passer à la suivante.
De plus j'aimerais également qu'il affiche les résultats comme demandé: par exemple si je tape "sa" qu'il m'affiche sacs, savon,.... et pas disposable.
Merci d'avance si quelqu'un peu m'aider.

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
50
51
52
Sub RechercheEtCouleur(Mot As String)
  Dim Rng As Range, Sht As Worksheet
  Dim FlgFind As Boolean
  Dim reponse As Integer
  Dim oldCel As String
 
  ' Initialiser le flag
  FlgFind = False
  ' Pour chaque feuille du classeur
  For Each Sht In ThisWorkbook.Sheets
    ' Eviter la recherche sur la feuille contenant le bouton
    If Sht.Name = "Recherche" Then GoTo Suite
    oldCel = Selection.Address  'pour se repositionner ensuite
 
    On Error Resume Next
    'effectue la recherche
    Set Rng = Sht.Cells.Find(What:=Mot, LookIn:=xlValues, LookAt:=xlPart, _
                             SearchOrder:=xlByRows, MatchCase:=False)
    'SearchDirection:=xlNext,
    ' Si aucune erreur, la valeur a été trouvée
    If Not Rng Is Nothing Then
      ' Si la valeur a été trouvée
      FlgFind = True
      ' On active la feuille ansi que la cellule
      Sht.Activate: Rng.Select
      With Rng.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
        .Font.ColorIndex = 3  'colorie en rouge
        .Font.Bold = True  'met en gras
      End With
      ' Remettre à ZERO la cellule trouvée
      Set Rng = Nothing
    End If
    On Error GoTo 0
    'nécessaire aussi pour stopper la recherche
    If FlgFind = True Then
      If MsgBox("Poursuivre recherche ?", vbYesNo) = vbYes Then
        FlgFind = False
        Selection.Font.ColorIndex = 0  'remise de la couleur noire
        Selection.Font.Bold = False  'enlever le gras
      Else
        Selection.Font.ColorIndex = 0  'idem plus haut si le bouton non est choisi
        Selection.Font.Bold = False
        Exit For  'on sort lorsque l'on presse le bouton non
      End If
    End If
Suite:
  Next Sht
  If FlgFind = False Then
    Sheets("Recherche").Activate
    Range(oldCel).Select  'on reprend notre place
  End If
End Sub

[casefayere]

Bonjour le forum, declc

si je nettoye ton code, tel qu'il est, ça donne ça

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
Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
 
For Each Sht In ThisWorkbook.Sheets
  If Sht.Name <> "Recherche" Then
    Set Rng = Sht.Cells.Find(What:=Mot, LookIn:=xlValues, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False)
    If Not Rng Is Nothing Then
      FlgFind = True
      With Sht.Rng.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
        .Font.ColorIndex = 3 'colorie en rouge
        .Font.Bold = True 'met en gras
      End With
    End If
'--------------------------------------
'ci-dessous, pourquoi ?
    Rng.Font.ColorIndex = 0 'remise de la couleur noire
    Rng.Font.Bold = False 'enlever le gras
'------------------------------------
    If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
      Exit For
    End If
  End If
Next Sht
End Sub

[declc]

Merci bien j'ai, joint le printscreen du message d'erreur avec ton nettoyage.


Sinon en fait le code recherche dans chaque feuille les lettres demandées et les mets en gras et en rouge et quand on poursuit la recherche les remets en noirs et simple.
mon problème est que lorsque je poursuis la recherche il me donne d'autres résultats mais dans les feuilles suivantes, il ne regarde pas si il y a d'autres réponses dans la feuille avant de passer à la suivante.

merci

[casefayere]

essayes d'adapter ce code

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
Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
Dim plage As Range, cel As Range
 
 
For Each Sht In ThisWorkbook.Sheets
  If Sht.Name <> "Feuil1" Then
    Set plage = Sht.Range("A3").CurrentRegion 'range("A3") à changer par la bonne cellule de départ
    For Each cel In plage
      If cel = Mot Then
        With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
          .Font.ColorIndex = 3 'colorie en rouge
          .Font.Bold = True 'met en gras
        End With
      End If
    Next cel
    If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
      Exit For
    End If
    For Each cel In plage
      cel.Font.ColorIndex = 0 'remise de la couleur noire
      cel.Font.Bold = False 'enlever le gras
    Next cel
  End If
Next Sht
End Sub

[declc]

Re-boujour je t'ai joint mon fichier afin que tu puisse tester et voir mon problème.
j'aimerais modifier le code suivant afin que quand il à trouvé une valeur dans une feuille il continue sa recherche sur cette même feuille avant de passer à la suivante.
De plus j'aimerais également qu'il affiche les résultats comme demandé: par exemple si je tape "sa" qu'il m'affiche sacs, savon,.... et pas disposable.
en effet comme dans mon ex. quand je recherche "sa" il trouve tout d'abord sacs dans la feuille "rangée A" si on poursuit la recherche il trouve de nouveau sacs en feuille"A6", alors que dans la feuille"rangée A" il y avait encore 2 cellules contenant "sacs".De plus si on poursuit la recherche il finit par aller en feuille"B5" pour me trouver disposable en me mettant en rouge et gras le"sp" alors que je recherchais "sa".
A essayer pour peut-être mieux visualiser, car je ne sais pas si c'est bien clair.
merci d'avance.

[casefayere]

Bonjour,

avant d'aller plus loin, revois déjà la structure de ton fichier, en effet, sur la feuille "rangée B" tes données commencent en B2 alors que dans les autres du même style, elles commencent en B3, sur les feuilles "A1", "A2", etc, elles commencent en C2 (d'ailleurs, dans quelles feuilles cherches-tu).
Sur les feuilles "rangée..." les cellules sont fusionnées sur une hauteur de 4 cellules et à partir de B23, sur une hauteur de 3 cellules, de plus les cellules fusionnées ne sont pas conseillées pour élaborer les procédures. Revoies déjà tout ça, je veux bien t'aider mais sur un travail structuré.

J'ai aussi vu que tu n'as pas tenu compte de mes propositions qui évitent les "Goto" et Cie. Si je t'aide, ça sera sur ces bases.

[declc]

bonjour,
en fait je recherche sur toutes les feuilles, pour ce qui est de la structure(cellule fussionée, ...) je vais regarder pour modifier cela.Quand au code pour éviter "Goto" et Cie je ne sais pas si je vais savoir faire qq chose car je suis tout à fait novice(c'est mon premier fichier avec des macros".
par contre dans ton exemple de code quand j'effectue une recherche sur "sa" il ne trouve rien et me demande de poursuivre la recherche en boucle?
Je vais essayer de modifier au mieux et reviens ensuite vers toi.
En tout cas un très grand merci pour l'aide.

[casefayere]

par contre dans ton exemple de code quand j'effectue une recherche sur "sa"

Maintenant que j'ai ton fichier, je pourrai corriger en fonction, j'attends le nouveau fichier restructuré

[declc]

Voilà,
j'ai restructuré le fichier, pour moi la recherche devrais débuter en cellule B3 de chaque feuilles exepté la feuille nommé"Recherche".
j'y ai placé ton code , essayé de le modifier mais je tourne en rond plus rien ne vas ! Dans quelle direction je dois chercher? merci d'avance.

[casefayere]

essayes ce code, attention à la ligne 12

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
Option Compare Text
Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
Dim plage As Range, cel As Range
 
 
For Each Sht In ThisWorkbook.Sheets
  If Sht.Name <> "Feuil1" Then
    Set plage = Sht.Range("B3").CurrentRegion 'range("B3") à changer par la bonne cellule de départ
    For Each cel In plage
      If cel Like Mot & "*" Then
      'ou       If cel Like "*" & Mot & "*" Then
        With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
          .Font.ColorIndex = 3 'colorie en rouge
          .Font.Bold = True 'met en gras
        End With
        Sht.Activate: cel.Activate
        If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
          With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
            .Font.ColorIndex = 0 'colorie en rouge
            .Font.Bold = False 'met en gras
          End With
          Exit Sub
        End If
      End If
    Next cel
    For Each cel In plage
      cel.Font.ColorIndex = 0 'remise de la couleur noire
      cel.Font.Bold = False 'enlever le gras
    Next cel
  End If
Next Sht
End Sub

[declc]

Bonjour Dom,
J’ai essayé ton code, mais avec la ligne 11, il ne se passe rien, donc je l’ai remplacée par la 12.
Et là on se rapproche vraiment de ce que je désir : le petit souci j’ai l’impression que les lettres recherchées se mettent en gras et rouge de façon aléatoire.
Par exemple je recherche « sa » pour « sacs » pour la première cellule qu’il trouve avec un mot contenant « sa » il me met A6 en gras et rouge si je poursuis la recherche il met SA si je continue c’est AC, puis AR, puis NT, puis CS ensuite SA, puis SA et pour finir ID. Là il ne trouve plus d’autre mots et il remet tous les caractères à l’initial (ce qui est normal) mais j’aimerais qu’en même temps on se repositionne sur la feuille « Recherche »(72). Par contre si on clique sur non pour ne pas poursuivre la recherche il ne réinitialise pas les caractères.
il y aurait-il une solution?
Merci à toi
Christophe

[declc]

Bonjour,
voilà, j'ai juste réussi à modifier le code pour qu'il retourne à la page "Recherche".
Mais la mise à l'initiale des caractères lorsque que l'on choisi "non" à "voulez-vous poursuivre la recherche", ainsi que la mise en rouge et gras uniquement des termes recherchés je ne trouve pas.
Si tu peux trouver quelque chose, un grand merci à plus tard.

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
Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
Dim plage As Range, cel As Range
 
 
For Each Sht In ThisWorkbook.Sheets
  If Sht.Name <> "Feuil1" Then
    Set plage = Sht.Range("B3").CurrentRegion 'range("B3") à changer par la bonne cellule de départ
    For Each cel In plage
      If cel Like "*" & Mot & "*" Then
      'ou       If cel Like "*" & Mot & "*" Then
        With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
          .Font.ColorIndex = 3 'colorie en rouge
          .Font.Bold = True 'met en gras
        End With
        Sht.Activate: cel.Activate
        If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
          With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
            .Font.ColorIndex = 0 'remise de la couleur noire
            .Font.Bold = False 'enlever le gras
          End With
          Exit Sub
          Else: Sheets("Recherche").Activate
        End If
      End If
    Next cel
    For Each cel In plage
      cel.Font.ColorIndex = 0 'remise de la couleur noire
      cel.Font.Bold = False 'enlever le gras
    Next cel
  End If
Next Sht
End Sub