Boucles Do Loop successives

**Kestion100** · 05/11/2015, 11h55

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

    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

**bboy-eazy** · 05/11/2015, 12h05

bonjour,

ceci devrait pouvoir vous aider:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Kestion100** · 05/11/2015, 13h20

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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....

**Kestion100** · 05/11/2015, 13h23

Très bon:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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!!!

**Igloobel** · 05/11/2015, 14h44

Bonjour,

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

A+

**Kestion100** · 05/11/2015, 14h48

Trop de solutions vaut mieux qu'aucune!!!!!!!

Boucles Do Loop successives

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager