Chercher et afficher une valeur malgré des lignes groupées
Bonsoir
LouReeD a écrit :c'est un truc comme cela ?
Oui c'est ça, j'avais vu ça dans un autre sujet et par chance je m'en suis souvenu
LouReeD a écrit :Entre nous, vous nous surveillez depuis quand
Pas de surveillance particulière, j'aime bien regarder de temps à autre une demande et voir comment elle est traitée (c'est très instructif)
Ce sujet me rappelle un autre post
Amicalement
ça date de mars 2013 et c'est avec bloug !!!!
Quel mémoire Banzaï64 !
Faut que je me méfie à ce que je dis et écrit !
Bonne fin de soirée, pour moi elle se termine...
@ bientôt
LouReeD
Bonsoir
C'est le sujet qui m'interpellait, je ne savais plus qui était le demandeur
Je trouve ça marrant et c'est bien, car pour résoudre ce problème, tu as eu une autre approche et bravo
Bonjour,
Merci LouReed et merci Banzai64.
Ultime (?) question : quand une occurrence est trouvée, une fenêtre s'ouvre avec 2 boutons : Oui et Non.
Y a-t-il un moyen simple pour remplacer Oui et Non par respectivement Abandonner et Poursuivre ?
(j'ai l'impression qu'il faut créer une fenêtre mais ça je ne sais pas du tout faire).
Merci.
Bonsoir,
à mon niveau je vous propose : [Recommencer] et [Annuler] où les valeurs tests sont respectivement 4 et 2, donc :
X = MsgBox("Référence """ & Str_critère & """ trouvée :" & Chr(13) & _
"Sur la feuille : " & ActiveSheet.Name & Chr(13) & _
"à l'adresse : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
"On recommence la recherche ?"& Chr(13) & Chr(13) & _
"Recommencer : on continue de chercher" & Chr(13) & _
"Annuler : on quitte" & Chr(13), vbDefaultButton1 + _
vbQuestion + vbRetryCancel, "Référence trouvée")puis pour le test du clic :
Select Case X
Case 4 'oui
Archives = Archives & ActiveSheet.Name & "!" & Cel.Address(0, 0) & Chr(10)
Trouvé = ActiveSheet.Name & "!" & Cel.Address(0, 0)
Exit For ' changement on ne quitte plus la sub mais seulement la boucle afin de pouvoir afficher la recherche total
Case Else 'Non=7
Archives = Archives & ActiveSheet.Name & "!" & Cel.Address(0, 0) & Chr(10)
ActiveCell.EntireRow.Hidden = Affichée
End Select@ bientôt
LouReeD
Rebonjour,
Merci de m'accompagner encore...
J'ai substitué les bouts de code et ça ne marche pas : le bouton "Recommencer" arrête la recherche.
Comme j'ai peut-être mal fait, voilà le code complet de la macro modifié :
Public Champ_Der_Recherche ' création d'une variable mémoire en public pour garder le dernier critère de recherche
Sub Macro_Recherche()
ActiveSheet.Outline.ShowLevels 1 ' on ferme tout
Dim Str_Plage As String
Dim Cel As Range
Dim Feuil As Worksheet
Dim Str_critère As String
Dim Str_critèrere As String
Dim X As Byte
Dim Message, Title, Default, Title2, Message2, Message3
Dim Affichée As Boolean
Dim Archives As String ' création d'une variable mémoire des différentes recherches trouvées
Dim Trouvé As String
Dim Tablo_Réponse(100) As String
Dim Incrémente_Tablo As Long
Incrémente_Tablo = 0
Trouvé = ""
Archives = ""
Message = "Entrez la référence recherchée : "
Message2 = "Désolé. Cette référence n'existe pas dans ce classeur."
Message3 = ""
Title = "Recherche de message"
Title2 = "Recherche infructueuse"
Default = ""
Str_Plage = ActiveSheet.UsedRange.Address '"A1:P160" ici la plage est dinamique et fonction des cellules utilisées
If Champ_Der_Recherche = "" Then ' si pas de recherche antérieure
Str_critère = LCase(InputBox(Message, Title, Default)) ' alors on de mande le critère qu'on met en minuscule
Champ_Der_Recherche = Str_critère ' on le met en mémoire
Else ' sinon
Str_critère = LCase(InputBox(Message, Title, Champ_Der_Recherche)) ' on propose en critère la dernière recherche qu'on met en minuscule
End If
If Str_critère = "" Then ' comme avant si la touche annuler est cliquée alors on quitte
Exit Sub
End If
' uniquement sur la feuille active : suppression de la boucle sur toutes les feuilles
' remplacement de "Feuil" par "ActiveSheet" dans le code
' suppression du code Feuil.Activate puisque par nature ActiveSheet est déjà sélectionnée
'For Each Feuil In Sheets
For Each Cel In ActiveSheet.Range(Str_Plage)
If InStr(LCase(Cel), Str_critère) Then ' on test des minuscules de valeur cellule avec le critère en minuscule...
Tablo_Réponse(Incrémente_Tablo) = "" & ActiveSheet.Name & "!" & Cel.Address(0, 0) & " : " & Cel.Value & Chr(10)
Incrémente_Tablo = Incrémente_Tablo + 1
'Feuil.Activate
Cel.Activate
Affichée = ActiveCell.EntireRow.Hidden
ActiveCell.EntireRow.Hidden = False
X = MsgBox("Référence """ & Str_critère & """ trouvée :" & Chr(13) & _
"Sur la feuille : " & ActiveSheet.Name & Chr(13) & _
"à l'adresse : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
"On recommence la recherche ?" & Chr(13) & Chr(13) & _
"Recommencer : on continue de chercher" & Chr(13) & _
"Annuler : on quitte" & Chr(13), vbDefaultButton1 + _
vbQuestion + vbRetryCancel, "Référence trouvée")
Select Case X
Case 4 'oui
Archives = Archives & ActiveSheet.Name & "!" & Cel.Address(0, 0) & Chr(10)
Trouvé = ActiveSheet.Name & "!" & Cel.Address(0, 0)
Exit For ' changement on ne quitte plus la sub mais seulement la boucle afin de pouvoir afficher la recherche total
Case Else 'Non=7
Archives = Archives & ActiveSheet.Name & "!" & Cel.Address(0, 0) & Chr(10)
ActiveCell.EntireRow.Hidden = Affichée
End Select
End If
Next Cel
'Next Feuil
If Archives = "" Then ' si archives est vide, la recherche n'a rien donnée
MsgBox ("Désolé. La référence ' " + Str_critère + " ' que vous cherchez n'existe pas dans ce classeur.")
Else ' sinon on affiche les différentes trouvailles
If Trouvé <> "" Then
If (Len(Archives) - Len(Replace(Archives, "!", "", , , False))) / Len("!") > 1 Then
Message3 = "Les différentes cellules concernant votre recherche sont :" & Chr(10) & Chr(10)
For i = 0 To (Len(Archives) - Len(Replace(Archives, "!", "", , , False))) / Len("!")
Message3 = Message3 & Tablo_Réponse(i)
Next i
Message3 = Message3 & Chr(10) & "Celle que vous recherchiez est : " & Trouvé & Chr(10) & Chr(10) & "@ bientôt."
MsgBox (Message3)
Else
Message3 = "La cellule concernant votre recherche est :" & Chr(10) & Chr(10)
For i = 0 To (Len(Archives) - Len(Replace(Archives, "!", "", , , False))) / Len("!")
Message3 = Message3 & Tablo_Réponse(i)
Next i
Message3 = Message3 & Chr(10) & "@ bientôt."
MsgBox (Message3)
'MsgBox ("La cellule concernant votre recherche est :" & Chr(10) & Chr(10) & Archives & Chr(10) & "@ bientôt.")
End If
Else
Message3 = "La recherche a trouvé :" & Chr(10) & Chr(10)
For i = 0 To (Len(Archives) - Len(Replace(Archives, "!", "", , , False))) / Len("!")
Message3 = Message3 & Tablo_Réponse(i)
Next i
Message3 = Message3 & Chr(10) & "Cette recherche ne vous convient pas." & Chr(10) & Chr(10) & "@ bientôt."
MsgBox (Message3)
'MsgBox ("La recherche a trouvé :" & Chr(10) & Chr(10) & Archives & Chr(10) & "Cette recherche ne vous convient pas." & Chr(10) & Chr(10) & "@ bientôt.")
End If
End If
End SubMerci !!!
Autant pour moi...
à la place de : Case 4
mettre : Case 2
@ bientôt
LouReeD
Re-,
Ça beugue sur
If InStr(LCase(Cel), Str_critère) Then(j'ai une erreur de type 13 : incompatibilité de type)
Pour moi, c'est du 中国.
recherche sur valeur numérique peut être...
bonne nuit...
Non non, je cherchais du texte en minuscules.
J'ai refait le test avec du texte exclusivement en majuscules : même résultat :^(
Bonsoir
chez moi cela ne bug pas...
voici :
@ bientôt
LouReeD
Ben avec ce fichier ça marche chez moi aussi.
J'avais dû mal faire un truc...
Une dernière fois : merci beaucoup !!!
Bonsoir,
et pas de quoi le forum sert à cela aussi !! mais il est vrai qu'un merci fait plaisir tout de même !
Donc merci pour votre merci !
@ bientôt
LouReeD
:^)