Bonjour à toutes et à tous
J'essaye d'adapter une macro de BrunoM45 pour effectuer une recherche de valeurs. A son code, j'ai rajouté un compteur à l'intérieur de la boucle Do loop. Mais là ou je sèche, c'est que j'aimerais également avoir le nombre total de valeurs trouvées. Cad 1 de 5, 2 de 5 etc ....
Et là je ne sais pas comment m'y prendre. Puisque la recherche de valeurs s'effectue à l'intérieur de ma boucle. Ou dois-je placer le countTot ?
Si quelqu'un peut m'expliquer l'astuce car dans l'état actuel, je sèche lamentablement
Philippe
Ci-dessous la macro
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim RngF As String, FirstCel As String
' Pour les Mat à mettre en ROUGE
Dim VCel1, VSearch1 As String
VCel1 = TextBox4.Value & " " & TextBox5.Value
' Valeur de recherche première partie avant l'espace
If Len(VCel1) > 0 Then VSearch1 = Left(VCel1, InStr(1, VCel1, " ") - 1) Else VSearch1 = ""
' Pour chaque feuille
For Each sh In ThisWorkbook.Worksheets
counter = 0
If sh.Name <> "fériés" And sh.Name <> "Répertoire" Then
sh.Activate
RngF = "$A$1": FirstCel = ""
'countTot = countTot + Application.CountIf( _
'Sh.UsedRange, "=" & Sh.Range(RngF))
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
counter = counter + 1
'countot = countTot + Application.CountIf( _
Sh.UsedRange, "=" & VSearch1 & Sh.Range(RngF))
' If countTot = 0 Then
' MsgBox " La valeur " & strSearchString & Chr(10) & "n'existe pas dans le planning."
' Exit Do
' Else
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 & vbNewLine & _
"(" & counter & " de " & countTot & ")", vbOKCancel)
If returnValue = vbCancel Then
Exit For
Else
If counter = countTot Then Exit For
End If
End If
' Mémorise l'adresse de la première cellule trouvée
If FirstCel = "" Then FirstCel = RngF
'End If
Loop
End If
Next
End Sub
J'essaye d'adapter une macro de BrunoM45 pour effectuer une recherche de valeurs. A son code, j'ai rajouté un compteur à l'intérieur de la boucle Do loop. Mais là ou je sèche, c'est que j'aimerais également avoir le nombre total de valeurs trouvées. Cad 1 de 5, 2 de 5 etc ....
Et là je ne sais pas comment m'y prendre. Puisque la recherche de valeurs s'effectue à l'intérieur de ma boucle. Ou dois-je placer le countTot ?
Si quelqu'un peut m'expliquer l'astuce car dans l'état actuel, je sèche lamentablement
Philippe
Ci-dessous la macro
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim RngF As String, FirstCel As String
' Pour les Mat à mettre en ROUGE
Dim VCel1, VSearch1 As String
VCel1 = TextBox4.Value & " " & TextBox5.Value
' Valeur de recherche première partie avant l'espace
If Len(VCel1) > 0 Then VSearch1 = Left(VCel1, InStr(1, VCel1, " ") - 1) Else VSearch1 = ""
' Pour chaque feuille
For Each sh In ThisWorkbook.Worksheets
counter = 0
If sh.Name <> "fériés" And sh.Name <> "Répertoire" Then
sh.Activate
RngF = "$A$1": FirstCel = ""
'countTot = countTot + Application.CountIf( _
'Sh.UsedRange, "=" & Sh.Range(RngF))
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
counter = counter + 1
'countot = countTot + Application.CountIf( _
Sh.UsedRange, "=" & VSearch1 & Sh.Range(RngF))
' If countTot = 0 Then
' MsgBox " La valeur " & strSearchString & Chr(10) & "n'existe pas dans le planning."
' Exit Do
' Else
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 & vbNewLine & _
"(" & counter & " de " & countTot & ")", vbOKCancel)
If returnValue = vbCancel Then
Exit For
Else
If counter = countTot Then Exit For
End If
End If
' Mémorise l'adresse de la première cellule trouvée
If FirstCel = "" Then FirstCel = RngF
'End If
Loop
End If
Next
End Sub
Dernière édition:
