Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Aide:Prob. dans mon code VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Vinvinsylvain

XLDnaute Junior
Bonjour a tous!!!!!!


Voici mon code qui permet de recherche

Dim countTot As Long
Dim counter As Long
Dim strSearchString As String
Dim Ws As Object
Dim foundCell As Variant
Dim loopAddr As Variant
Dim returnValue As String
Dim strSearchString1 As String
Dim MyCollection As String

strSearchString = TxtNomVol.Value
strSearchString1 = TxtPrénomVol.Value

If strSearchString1 = '' Then strSearchString = '' Else


For Each Ws In Worksheets
countTot = countTot + Application.CountIf(Ws.UsedRange, '=' & strSearchString)
Next Ws
If countTot = 0 Then
returnValue = MsgBox(' Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' n'est pas connue de nos fichiers ', vbOKOnly, ' Message ')
Else
counter = 0
For Each Ws In Worksheets
With Ws
.Activate
Set foundCell = .Cells.Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
loopAddr = foundCell.Address
Do
counter = counter + 1
foundCell.Activate
If countTot = 2 Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' EST CONNUE DE NOS SERVICE, veuillez continué le constat de vol et intérroger le Récap. Interpelle ', vbOKOnly, ' Message ')
Exit Sub
End If
If counter = countTot Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' sélectionnée est la dernière !', vbOKOnly, 'Message')
Exit Sub
Else
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' a été ' & countTot & vbLf)
If returnValue = vbNo Then Exit For
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr
End If
End With
Next Ws
End If




Mon probleme s'est qu'il recherche la valeur (TxtNomVol et TxtPrénomVol) dans tous le classeur, j'aimerai qu'il recherche seulement dans la feuille RéCap. comment je peut fair.
Merci de Votre aide
 
J'ai trouver se code en additionnant plusieur il marche un peut j'ai reposer dans le forum la question pour il voir un peut plus claire car je suis perdu.


Dim Mot As String
Dim Mot2 As String
Dim Nbre As Long
Dim Nbre2 As Long
Dim Cycle As Long
Dim Trouvé As Variant
Dim CellAddress As Variant
Dim MyValue As String

'Définition de la variable à rechercher
Mot = TxtNomVol.Value
Mot2 = TxtPrénomVol.Value
'Vérification si existante

For Each Ws In Worksheets('Récap. Interpelle').Range('A1:F1000')
Nbre = Nbre + Application.CountIf(Ws.Range('E1:F1000'), '=' & Mot)
Next Ws
'Message en cas de mot inexistant
If Nbre = 0 Then
MyValue = MsgBox('Ce Nom: ' & Mot & ' ' & Mot2 & 'n'est pas enregistré dans nos fichiers', vbOKOnly, ' Message ')
Else
Cycle = 0
If Nbre = 1 Then
MyValue = MsgBox('Ce Nom: ' & Mot & ' ' & Mot2 & ' est connu une fois dans nos fichiers, veuillez continuer l'édition du constat de vol, puis faire une recherche dans le Récap. Interpelle ', vbOKOnly, ' Message ')
Else
Cycle = 1
If Nbre = 2 Then
MyValue = MsgBox('Ce Nom: ' & Mot3 & ' ' & Mot2 & ' est connu deux fois dans nos fichiers, veuillez continuer l'édition du constat de vol, puis veuillez faire une recherche dans le Récap. Interpelle ', vbOKOnly, ' Message ')
Else
Cycle = 2
If Nbre = 3 Then
MyValue = MsgBox('Ce Nom: ' & Mot & ' ' & Mot2 & ' est connu trois fois dans nos fichiers, veuillez continuer l'édition du constat de vol, puis veuillez faire une recherche dans le Récap. Interpelle ', vbOKOnly, ' Message ')
Else
Cycle = 3
Nbre2 = Nbre + 3
If Nbre2 = Nbre + 3 Then
MyValue = MsgBox('Ce Nom: ' & Mot & ' ' & Mot2 & ' est connu plusieurs fois dans nos fichiers, veuillez continuer l'édition du constat de vol, puis veuillez faire une recherche dans le Récap. Interpelle ', vbOKOnly, ' Message ')
Else
End If
End If
End If
End If
End If
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
334
Réponses
4
Affichages
407
  • Question Question
Microsoft 365 Problème de date
Réponses
5
Affichages
267
  • Question Question
Microsoft 365 Excel VBA
Réponses
5
Affichages
464
Réponses
4
Affichages
581
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…