Momone21
Messages postés23Date d'inscriptiondimanche 17 avril 2005StatutMembreDernière intervention 4 décembre 2006
-
11 sept. 2005 à 20:33
valtrase
Messages postés937Date d'inscriptionlundi 19 janvier 2004StatutMembreDernière intervention 9 mai 2022
-
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
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
valtrase
Messages postés937Date d'inscriptionlundi 19 janvier 2004StatutMembreDernière intervention 9 mai 20223 15 sept. 2005 à 01:16
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
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
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
Momone21
Messages postés23Date d'inscriptiondimanche 17 avril 2005StatutMembreDernière intervention 4 décembre 2006 13 sept. 2005 à 07:46
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 "
valtrase
Messages postés937Date d'inscriptionlundi 19 janvier 2004StatutMembreDernière intervention 9 mai 20223 14 sept. 2005 à 01:23
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.