Boucles Do Loop successives

Version imprimable

Bonjour,

Ma feuille de calculs contient de A1 à A200 une liste de noms et je cherche à ce que mon code sélectionne la dernière cellule dans laquelle le nom que je rentre dans une Input Box se trouve.
Ces noms peuvent, ou non, se répéter plusieurs fois.

Pour l'instant, j'utilise un code qui fonctionne très bien pour trouver la première cellule dans laquelle le nom se trouve et la dérive pour la deuxième occurrence mais il me semble fastidieux de poursuivre ainsi avec un code qui pourrait aller jusqu'à une douzaine d'occurrences.

Le code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$A$1" Then Dim Lig As Long, Nom As String, Line As Long, Col As Long, LignSel As Long On Error GoTo errorHandler2 Nom = InputBox("Saisie de votre NOM : ", "NOM") If Nom = "" Then Exit Sub Else errorHandler2: Dim cel As Range If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 1 Then MsgBox "OK" Do Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row Exit Sub Loop While Not cel Is Nothing End If End If If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 2 Then Do Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row Exit Sub Loop While Not cel Is Nothing End If End If End Sub
Pour synthétiser, la feuille de calculs:

A1 : Michel
A2: Patrick
A3: Robert
.
.
.

A42: Robert
.
.
.
A105: Robert
.
.
.

Mon code, pour l'instant, fonction très bien pour sélectionner la cellule où se trouve Michel ou Patrick ainsi que Robert en A3 et A42 mais, pour le Robert en A105, il me faudrait encore répéter un:
Code:

1 2 3 4 Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) 'MsgBox cel If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row
A l'intérieur de:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Do Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns) If Not cel Is Nothing Then cel.Activate LignSel = ActiveCell.Row Exit Sub Loop While Not cel Is Nothing End If
Pour:

Code:

If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 3 Then

Et ainsi de suite jusqu'à une bonne douzaine de fois.

Quelqu'un pourrait il m'apporter une aide précieuse?

MERCI D'AVANCE

bonjour,

ceci devrait pouvoir vous aider:

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
With Worksheets(1).Range("a1:a500")
    Set c = .Find("Pierre", LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
        MsgBox c.Address
        Set c = .FindNext(c)
        Loop While Not c Is Nothing 
    End If
End With
End Sub

J'ai essayé d'adapter pour mon cas:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
 
 
  Dim Lig As Long, Nom As String, Line As Long, Col As Long, LignSel As Long
 
Nom = InputBox("Saisie de votre NOM : ", "NOM")
If Nom = "" Then
Exit Sub
Else
MsgBox "OK"
With Sheets("RECUP").Range("a1:a500")
    Set C = .Find("Nom", LookIn:=xlValues)
    If Not C Is Nothing Then
        Do
        MsgBox C.Address
        Set C = .FindNext(C)
        Loop While Not C Is Nothing
    End If
End With
End If
End If
End Sub

J'ai bien ma MsgBox "OK" qui apparaît, donc les conditions sont bien détectées mais ensuite, rien ne se passe....????

Je viens de fermer rouvrir le classeur, en fait la MsgBox renvoie "$A$1" en boucle

Avec:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
 
 
  Dim Lig As Long, Nom As String, Line As Long, Col As Long, LignSel As Long
 
Nom = InputBox("Saisie de votre NOM : ", "NOM")
If Nom = "" Then
Exit Sub
Else
 
With Sheets("RECUP").Range("a1:a500")
 
'MsgBox Nom
    Set C = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
    'MsgBox C
    If Not C Is Nothing Then
        Do
        MsgBox C.Address
        Set C = .FindNext(C)
        Loop While Not C Is Nothing
    End If
End With
End If
End If
End Sub

La MsgBox me renvoie bien les adresses des cellules dans lesquelles sont le nom demandé, nous y sommes donc presque mais le code n'arrive pas à sortir de la boucle et n'active donc aucune cellule....

Très bon:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
 
 
  Dim Lig As Long, Nom As String, Line As Long, Col As Long, LignSel As Long
 
Nom = InputBox("Saisie de votre NOM : ", "NOM")
If Nom = "" Then
Exit Sub
Else
 
With Sheets("RECUP").Range("a1:a500")
 
'MsgBox Nom
    Set C = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
    'MsgBox C
    If Not C Is Nothing Then
        Do
        'MsgBox C.Address
        Set C = .FindNext(C)
        C.Activate
        Exit Sub
 
        Loop While Not C Is Nothing
 
    End If
End With
End If
End If
End Sub

mais pour l'instant, le cas de plus de 2 occurrences ne se présente pas....

RESOLU en attedant

MERCI!!!

Bonjour,

Bon je sais que c'est résolu mais je poste qd même une autre solution

Citation:

Bonjour,

Ma feuille de calculs contient de A1 à A200 une liste de noms et je cherche à ce que mon code sélectionne la dernière cellule dans laquelle le nom que je rentre dans une Input Box se trouve.

Donc on part de la fin !!!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub test() Dim NomF As String Dim Nom As String Dim Derlign As Long Dim Lign As Long NomF = "Feuil1" Nom = InputBox("Saisie de votre NOM : ", "NOM") Derlign = ThisWorkbook.Worksheets(NomF).UsedRange.Rows.Count For Lign = Derlign To 1 Step -1 If Cells(Lign, 1).Value = Nom Then Exit For End If Next Rows(Lign).Select End Sub
c'est a mon avis extrêmement simple :aie:

A+

05/11/2015, 14h48
Kestion100

Trop de solutions vaut mieux qu'aucune!!!!!!! :P
06/11/2015, 13h23
Marc-L

Bonjour, bonjour !

La voie directe et efficace est d'utiliser la méthode Range.Find sans boucle : il suffit juste de lire l'aide VBA

et donc de bien paramétrer ses arguments notamment SearchDirection …

______________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse