Aide pr rajouter 1 compteur ds 1 msgbox style 1 de 1

[antiphot]

Bonjour à toutes et à tous

Dans la macro suivante, j'effectue une recherche dans le classeur des valeurs rentrées dans mes deux textbox.
Ex; je recherche dans les feuilles la valeur 251a ou 251 a ou 25A ou 251 A. La routine fonctionne très bien

Je souhaiterais rajouter 1 compteur dans le msgbox de façon à avoir le nombre total d'occurences trouvées.

Ce qui donnerait: 1 de 5, 2 de 5, etc ......
Je sais rajouter un compteur style counter = counter +1 mais je ne sais pas comment définir le nombre total d'occurences ?

Je ne sais pas si je suis suffisament clair ?

Je joint a ce post un fichier exemple. La macro s'exécute par le cmdbutton sur la feuille Repertoire.
Pr l'exemple, rentrer dans le 1er textbox la valeur 251 et a dans le 2ème.

Merci par avance pour toutes vos propositions.

Cordialement Philippe

Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim RngF As String, FirstCel As String
Dim VCel1, VSearch1 As String

  VCel1 = TextBox4.Value & " " & TextBox5.Value
  VSearch1 = TextBox4.Value
   
  ' Pour chaque feuille
For Each sh In ThisWorkbook.Worksheets
  
    If sh.Name <> "fériés" And sh.Name <> "Répertoire" Then
      sh.Activate
      
      RngF = "$A$1": FirstCel = ""
            
             Do While VSearch1 <> ""
                    
                    On Error Resume Next
                    sh.Cells.Find(what:=VSearch1, After:=sh.Range(RngF), LookIn:=xlValues, LookAt:=xlPart, _
                      SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
                      SearchFormat:=False).Activate
                      RngF = Selection.Address
                     
                    
                            On Error GoTo 0
                            ' Sort de la boucle si pas trouvé ou revenu sur 1ère cellule
                            If RngF = "$A$1" Or RngF = FirstCel Then Exit Do
                            ' Sinon on vérifie si les données sont identiques
                            If UCase(Replace(sh.Range(RngF).Value, " ", "")) = UCase(Replace(VCel1, " ", "")) Then
                                             
                                returnValue = MsgBox("La valeur cherchée " & VCel1 & _
                                          " a été trouvé semaine: " & sh.Name & " cellule " & sh.Range(RngF).Address, _
                                          vbOKCancel)
                                          If returnValue = vbCancel Then
                                            Exit For
                                          End If
                            End If
                            ' Mémorise l'adresse de la première cellule trouvée
                            If FirstCel = "" Then FirstCel = RngF
            Loop
     End If
Next
End Sub

 

[CBernardT]

Re : Aide pr rajouter 1 compteur ds 1 msgbox style 1 de 1

Bonjour antiphot et le forum,

Une petite modification de la macro :

Private Sub CommandButton1_Click()
Dim sh As Worksheet, N As Byte
Dim RngF As String, FirstCel As String
Dim VCel1, VSearch1 As String

VCel1 = TextBox4.Value & " " & TextBox5.Value
VSearch1 = TextBox4.Value

' Pour chaque feuille
For Each sh In ThisWorkbook.Worksheets

If sh.Name <> "fériés" And sh.Name <> "Répertoire" Then
sh.Activate

RngF = "$A$1": FirstCel = ""

Do While VSearch1 <> ""
N = N + 1
On Error Resume Next
sh.Cells.Find(what:=VSearch1, After:=sh.Range(RngF), LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
RngF = Selection.Address
On Error GoTo 0
' Sort de la boucle si pas trouvé ou revenu sur 1ère cellule
If RngF = "$A$1" Or RngF = FirstCel Then Exit Do
' Sinon on vérifie si les données sont identiques
If UCase(Replace(sh.Range(RngF).Value, " ", "")) = UCase(Replace(VCel1, " ", "")) Then

returnValue = MsgBox("La valeur cherchée " & VCel1 & _
" a été trouvé semaine: " & sh.Name & " cellule " & sh.Range(RngF).Address, _
vbOKCancel)
If returnValue = vbCancel Then
Exit For
End If
End If
' Mémorise l'adresse de la première cellule trouvée
If FirstCel = "" Then FirstCel = RngF
Loop
End If
Next
MsgBox N & " Occurences a(ont) été trouvée(s) !"
End Sub

Cordialement

Bernard

 

[antiphot]

Re : Aide pr rajouter 1 compteur ds 1 msgbox style 1 de 1

Bonjour CBernardT

Merci pour ta réponse. Néanmoins cela ne correspond pas exactement à ce que je veux. Je vais essayer d'être plus clair. En fait je fais une recherche sans tenir compte de la casse ni des espaces d'une valeur ex: 251 a. Le nb d'occurences doit correspondre a la valeur 251 a qui peut être écrite dans le classeur 251a 251 A 251A etc et non pas uniquement des a....

Le msgbox existe déjà dans ma macro initiale mais à l'intérieur de ma boucle do loop.

Le mieux (sans vouloir abuser bien sûr) serait de tester le fichier joint. Je pense que cela vaudra mieux qu'un long discours.

Encore merci pour ton aide

Philippe