Probleme avec un code de recherche en vba excel
Résolu
Momone21
Messages postés
23
Date d'inscription
dimanche 17 avril 2005
Statut
Membre
Dernière intervention
4 décembre 2006
-
11 sept. 2005 à 20:33
valtrase Messages postés 937 Date d'inscription lundi 19 janvier 2004 Statut Membre Dernière intervention 9 mai 2022 - 15 sept. 2005 à 01:16
valtrase Messages postés 937 Date d'inscription lundi 19 janvier 2004 Statut Membre Dernière intervention 9 mai 2022 - 15 sept. 2005 à 01:16
7 réponses
valtrase
Messages postés
937
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
9 mai 2022
3
15 sept. 2005 à 01:16
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
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é
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é
valtrase
Messages postés
937
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
9 mai 2022
3
12 sept. 2005 à 01:06
12 sept. 2005 à 01:06
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é
ç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
Messages postés
23
Date d'inscription
dimanche 17 avril 2005
Statut
Membre
Dernière intervention
4 décembre 2006
12 sept. 2005 à 22:44
12 sept. 2005 à 22:44
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
"Récap. Interpelle"
For Each Ws In Worksheets("Récap. Interpelle")
que doit je faire
Momone21
valtrase
Messages postés
937
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
9 mai 2022
3
13 sept. 2005 à 00:58
13 sept. 2005 à 00:58
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é
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é
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Momone21
Messages postés
23
Date d'inscription
dimanche 17 avril 2005
Statut
Membre
Dernière intervention
4 décembre 2006
13 sept. 2005 à 07:46
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 "
Momone21
hors il devrait me marqué " cette personne est connue de nos service "
Momone21
valtrase
Messages postés
937
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
9 mai 2022
3
14 sept. 2005 à 01:23
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.
Cordialement, Jean-Paul
______________________________________________________________________
Le Savoir n'a de valeur que s'il est partagé
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
Messages postés
23
Date d'inscription
dimanche 17 avril 2005
Statut
Membre
Dernière intervention
4 décembre 2006
14 sept. 2005 à 21:33
14 sept. 2005 à 21:33
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
Momone21
