Erreur avec FindNext

**apt** · 21/11/2013, 22h49

Bonjour à tous,

Dans le code ci-dessous, j’utilise Find et FindNext pour parcourir une plage de cellules issues d’un filtre automatique (Plage discontinue).

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
Sub test()
    Dim Zone As Range, C, Depart As String
    Dim MonDico As Object
    Dim Cel As Range, Rng As Range, Rng2 As Range
    Dim i As Integer
 
    With Worksheets(1)
        With .Range("A1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            .AutoFilter
            .AutoFilter Field:=2, Criteria1:="EVR"
        End With
    End With
    With ActiveSheet.AutoFilter.Range
        On Error Resume Next
        Set Rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 6) _
                   .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
    If Rng2 Is Nothing Then
        MsgBox "No data to copy"
        Exit Sub
    Else
 
        Set MonDico = CreateObject("Scripting.Dictionary")
        Set Zone = Intersect(Rng2, [A:A])
 
        MsgBox "Zone : " & Zone.Address
 
        ' -- Noms sans doublons
        For Each Cel In Zone
            If Not MonDico.Exists(Trim(Cel.Value)) Then MonDico.Add Trim(Cel.Value), Trim(Cel.Value)
        Next Cel
 
        For Each C In MonDico.Keys
            Set Cel = Zone.Find(what:=Trim(C), LookIn:=xlValues, lookat:=xlPart)
            If Not Cel Is Nothing Then
                Depart = Cel.Address
                i = i + 1
                Do
                    MsgBox "Cel : " & Cel & ", ligne i : " & i
                    Set Cel = Zone.FindNext(C)
                Loop While Not Cel Is Nothing And Depart <> Cel.Address
            End If
 
        Next C
    End If
    ActiveSheet.ShowAllData
 
End Sub

Mais L’exécution du code s’arrête à la ligne :

Code :

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

Set Cel = Zone.FindNext(C)

Avec cette erreur :

Erreur d’exécution : 1004
Impossible de lire la propriété FindNext de la classe range

http://cjoint.com/?CKvuYCYTA7x

Merci d’avance.

**boisgontierjacques** · 21/11/2013, 23h13

Bonjour,

Ci dessous, un essai qui fonctionne.

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
 
Sub cherche_plusieurs()
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  [d1].Resize(, mondico.Count) = mondico.keys
  [A:B].Interior.ColorIndex = xlNone
  Set zone = [_FilterDataBase].Resize(, 1).SpecialCells(xlCellTypeVisible)
  For Each elem In mondico.keys
     Set c = zone.Find(elem, , , xlWhole)
     If Not c Is Nothing Then
       premier = c.Address
       Do
        c.Resize(, 2).Interior.ColorIndex = 4
        Set c = zone.FindNext(c)
       Loop While Not c Is Nothing And c.Address <> premier
     End If
     Stop
   Next elem
End Sub

Jacques Boisgontier