find / findnext

Version imprimable

find / findnext

* Bonjour *

J'essaye d’écrire un macro qui cherche une valeur dans une feuille et pour chaque résultat trouvé écrire une valeur dans la cellule adjacente. Mais le problème est que ce code ne change que la première resultat trouvé et pas les autres, aidez moi svp

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
Sub adresse_mo()
 
    Dim connecteur As String
    connecteur = "HSK"
    Dim adresse As String
    adresse = "E8"
    Dim coladr As Integer
    Dim rowadr As Integer
    Dim rngFound As Range
    Dim FirstAddress As String
 
 With Feuil1.Range("F2:F20")
 
    Set rngFound = .Find(what:=connecteur)
    coladr = Cells.FindNext(After:=ActiveCell).Column
    rowadr = Cells.FindNext(After:=ActiveCell).Row
    coladr = coladr + 2
    Cells(rowadr, coladr) = adresse
    FirstAddress = rngFound.Address
    Set rngFound = Cells.FindNext(After:=rngFound)
 
    Do Until rngFound.Address = FirstAddress
 
      coladr = Cells.FindNext(After:=ActiveCell).Column
      rowadr = Cells.FindNext(After:=ActiveCell).Row
      coladr = coladr + 2
      Cells(rowadr, coladr) = adresse
      Set rngFound = Cells.FindNext(After:=rngFound)
 
 
    Loop
 
 End With

Bonsoir,

Sous réserve d'avoir bien compris ton attente

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub adresse_mo()
Dim connecteur As String
Dim adresse As String
Dim rngFound As Range
Dim FirstAddress As String
    adresse = "E8"
    connecteur = "HSK"
    With Feuil1.Range("F2:F20")
        Set rngFound = .Find(connecteur, LookIn:=xlValues, lookat:=xlPart)
        If Not rngFound Is Nothing Then
            FirstAddress = rngFound.Address
            Do
                rngFound.Offset(0, 1).Value = adresse
                Set rngFound = .FindNext(rngFound)
            Loop While Not rngFound Is Nothing And rngFound.Address <> FirstAddress
        End If
        Set rngFound = Nothing
    End With
End Sub

Cordialement.

12/02/2013, 20h57
falleg

find / findnext

Merci bien frero :ccool: