Probleme avec un code de recherche en vba excel [Résolu]

Momone21 23 Messages postés dimanche 17 avril 2005Date d'inscription 4 décembre 2006 Dernière intervention - 11 sept. 2005 à 20:33 - Dernière réponse : valtrase 936 Messages postés lundi 19 janvier 2004Date d'inscription 17 mars 2017 Dernière intervention
- 15 sept. 2005 à 01:16
bonsoir a tous


j'ai besoin d'aide sur le code suivant:


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


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


If strSearchString "" Then strSearchString1 "" Else



For Each Ws In Worksheets
countTot = countTot + Application.CountIf(Ws.UsedRange, "=" & strSearchString)
Next Ws
If countTot = 0 Then
returnValue = MsgBox(" Cette Personne : " & strSearchString & " 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 = 1 Then
returnValue = MsgBox("Cette Personne : " & strSearchString & " 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 & " a été interpellé" & " " & countTot & " fois " & 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

Ce code me permet de faire une recherche automatique, mais mon problème s'est qu'il recherche dans tous le classeur la valeur contenue dans la TxtNomVol, je voudrais qu'il recherche seulement dans la feuille Récap. Interpelle
et qu'il recherche avec la valeur de la txtNomVol et la Valeur TxtPrénomVol séparément
pouvez vous m'aidez


Momone21
Afficher la suite 

7 réponses

Meilleure réponse
valtrase 936 Messages postés lundi 19 janvier 2004Date d'inscription 17 mars 2017 Dernière intervention - 15 sept. 2005 à 01:16
3
Merci
Je reviens sur le sujet .......
je ne sais pas trop ce que tu voulais faire sur le test de la dernière personne si tu dois savoir si c'est la dernière personne de la liste change le code comme ci-dessous. (les modifs sont en rouge)

Dim countTot As Long: Dim strSearchString As String: Dim strSearchString1 As String: Dim Ws As Range
Dim counter As Long: Dim CountWithName As Long: Dim rRow As Long: Dim CountRow


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


If strSearchString "" Then strSearchString1 "": MsgBox "Vous devez indiquer un nom !" ': Exit Sub
CountWithName = 0
countTot = 0


rRow = Worksheets("Récap. Interpelle").UsedRange.Range("A1").Row
counter = rRow


For Each Ws In Worksheets("Récap. Interpelle").UsedRange
If rRow <> Ws.Row Then
rRow = Ws.Row
counter = counter + 1
End If
'*** La fonction NoAccent supprime les accents pour ne pas avoir de prob de recherche
If NoAccent(Ws.Text, 1) = NoAccent(strSearchString, 1) Then
CountWithName = CountWithName + 1
'*** Ici changer l'offset en fonction de la cellule de recherche pour le prénom
'*** par exemple même ligne et une colonne à gauche

If NoAccent(Ws.Offset(0, -1).Text, 1) = NoAccent(strSearchString1, 1) Then countTot countTot + 1: CountRow Ws.Row
End If
End If
Next

Select Case countTot
Case Is = 0
If CountWithName >= 1 Then
MsgBox "Cette personne est connue mais avec un autre prénom !"
Else
MsgBox " Cette Personne : " & strSearchString & _
" n'est pas connue de nos fichiers ", vbOKOnly, " Message "
End If
Case Is = 1
MsgBox "Cette Personne : " & strSearchString & " EST CONNUE DE NOS SERVICE," _
& "veuillez continué le constat de vol et intérroger le Récap. Interpelle ", vbOKOnly, " Message "
If CountRow = counter Then MsgBox "Cette personne est la dernière !"
Case Is > 1
MsgBox ("Cette Personne : " & strSearchString & " a été interpellé" & " " & countTot & " fois " & vbLf)

If CountRow = counter Then MsgBox "Cette personne est la dernière !"
Case Else

End Select






End Sub

Cordialement, Jean-Paul
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partagé

Merci valtrase 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 94 internautes ce mois-ci

valtrase 936 Messages postés lundi 19 janvier 2004Date d'inscription 17 mars 2017 Dernière intervention - 12 sept. 2005 à 01:06
0
Merci
Salut,
ça devrai ressembler à ceci ....

Dim countTot As Long: Dim strSearchString As String: Dim strSearchString1 As String: Dim Ws As Range
Dim counter As Long


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


If strSearchString "" Then strSearchString1 "": MsgBox "Vous devez indiquer un nom !" ': Exit Sub
countwithname = 0
countot = 0
counter = 0


For Each Ws In Worksheets("Récap. Interpelle")
counter = counter + 1
'*** La fonction NoAccent supprime les accents pour ne pas avoir de prob de recherche
If NoAccent(Ws.Text, 1) = NoAccent(strSearchString, 1) Then
countwithname = countwithname + 1
'*** Ici changer l'offset en fonction de la cellule de recherche pour le prénom
'*** par exemple même ligne et une colonne à gauche

If NoAccent(Ws.Offset(0, -1).Text, 1) = NoAccent(strSearchString1, 1) Then
countTot = countTot + 1
End If
End If
Next

Select Case countTot
Case Is = 0
If countwithname >= 1 Then
MsgBox "Cette personne est connue mais avec un autre prénom !"
Else
MsgBox " Cette Personne : " & strSearchString & _
" n'est pas connue de nos fichiers ", vbOKOnly, " Message "
End If
Case Is = 1
MsgBox "Cette Personne : " & strSearchString & " EST CONNUE DE NOS SERVICE," _
& "veuillez continué le constat de vol et intérroger le Récap. Interpelle ", vbOKOnly, " Message "
If countTot = counter Then MsgBox "Cette personne est la dernière !"
Case Is > 1
MsgBox ("Cette Personne : " & strSearchString & " a été interpellé" & " " & countTot & " fois " & vbLf)
If countTot = counter Then MsgBox "Cette personne est la dernière !"
Case Else

End Select

'*** CE CODE EST A METTRE DANS UN MODULE
'==============================================


Dim Conv As Integer
Dim T2 As String


Function NoAccent(Texte As String, Optional Casse) As String


Dim i As Integer
Dim C As String * 1


If IsMissing(Casse) Then Conv 0 Else Conv Casse
T2 = ""


For i = 1 To Len(Texte)


C = Mid$(Texte, i, 1)


Select Case C


Case "A" To "Z": Convert 1, LCase$(C), C
Case "a" To "z": Convert 2, UCase$(C), C


Case "è" To "ë": Convert 2, "E", "e"
Case "à" To "å": Convert 2, "A", "a"
Case "ò" To "ö": Convert 2, "O", "o"
Case "ù" To "ü": Convert 2, "U", "u"
Case "ç": Convert 2, "C", "c"


Case "È" To "Ë": Convert 1, "e", "E"
Case "À" To "Å": Convert 1, "a", "A"
Case "Ò" To "Ö": Convert 1, "o", "O"
Case "Ù" To "Ü": Convert 1, "u", "U"
Case "Ç": Convert 1, "c", "C"


Case "ì" To "ï": Convert 2, "I", "i"
Case "ñ": Convert 2, "N", "n"
Case "š": Convert 2, "S", "s"
Case Chr$(158): Convert 2, "Z", "z"
Case "ý", "ÿ": Convert 2, "Y", "y"


Case "Ì" To "Ï": Convert 1, "i", "I"
Case "Ñ": Convert 1, "n", "N"
Case "Š": Convert 1, "s", "S"
Case Chr$(142): Convert 1, "z", "Z"
Case "Ý", "Ÿ": Convert 1, "y", "Y"


Case Else: T2 = T2 & C


End Select


Next i


NoAccent = T2


End Function


Private Function Convert(Cdt As Integer, _
R1 As String, R2 As String) As String


If Conv Cdt Then T2 T2 & R1 Else T2 = T2 & R2


End Function


'==============================================

Cordialement, Jean-Paul
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partagé
Momone21 23 Messages postés dimanche 17 avril 2005Date d'inscription 4 décembre 2006 Dernière intervention - 12 sept. 2005 à 22:44
0
Merci
désoler mais j'ai une érreur a partir de se code, il ne veut pas
"Récap. Interpelle"

For Each Ws In Worksheets("Récap. Interpelle")

que doit je faire


Momone21
valtrase 936 Messages postés lundi 19 janvier 2004Date d'inscription 17 mars 2017 Dernière intervention - 13 sept. 2005 à 00:58
0
Merci
Re
For Each Ws In Worksheets("Récap. Interpelle").UsedRange
Désolé

Cordialement, Jean-Paul
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partagé
Momone21 23 Messages postés dimanche 17 avril 2005Date d'inscription 4 décembre 2006 Dernière intervention - 13 sept. 2005 à 07:46
0
Merci
merci ton code marche mais dans le Récap. Interpelle il y a sur la meme ligne le Nom et le Prénom dans deux colonne séparer, quand je fais une recherche j'ai le message "Cette personne est connue mais avec un autre prénom !"
hors il devrait me marqué " cette personne est connue de nos service "


Momone21
valtrase 936 Messages postés lundi 19 janvier 2004Date d'inscription 17 mars 2017 Dernière intervention - 14 sept. 2005 à 01:23
0
Merci
Re,
Cela vient du fait que tu dois modifier la ligne ci-desous comme je te le précisait dans mon post.

If NoAccent(Ws.Offset(0, -1).Text, 1) = NoAccent(strSearchString1, 1) Then
countTot = countTot + 1
End If

Tu dois changer les valeur en rouge (ici on recherche le prénom sur la même ligne et une colonne à gauche
Ws.Offset(Row, Column). Donc tu dois le paramétrer par rapport a tes données sur ta feuille. Le point de départ étant la cellule du nom.

Le code fait une recherche sur le nom et le prénom et s'il ne trouve pas. Sur le nom seulement.

Cordialement, Jean-Paul
______________________________________________________________________

Le Savoir n'a de valeur que s'il est partagé
Momone21 23 Messages postés dimanche 17 avril 2005Date d'inscription 4 décembre 2006 Dernière intervention - 14 sept. 2005 à 21:33
0
Merci
Houppps!!!! j'avais pas compris, maintenant sa fonctionne très bien merci pour ton aide, et te souhaite une très bonne soirée à+


Momone21

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.