Méthode find avec boucle

**munity** · 16/10/2018, 19h34

bonsoir à tous

j'ai développé une macro grace au phorum sur find et findnext
mais cela ne me donne pas exactement ce que je souhaiterai
en effet j'ai deux tableaux un fichier stock avec code et désignation
et un second ou je n'ai que la désignation
je cherche donc à récupérer le code pour mon second tableau
jusqu'ici tout va bien par contre si j'ai plusieurs désignation identiques, il ne me mets que la première
je me doute qu'il faut certainement ajouté un test ou boucle mais je ne vois pas trop ou
voici mon 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
 
 
Sub test()
LePath = ActiveWorkbook.Path & "\"
ClasseurActif = ActiveWorkbook.Name
 
Application.Workbooks.Open LePath & "\ETAT DE STOCKS_AUTOMATE.xls" '
 
    ligne = Cells(Rows.Count, 2).End(xlUp).Row
    Sheets("STOCK").Range("b2:e" & ligne).Copy
    Workbooks(ClasseurActif).Activate
 
    ActiveWorkbook.Worksheets.Add
    ActiveSheet.Name = "stock"
    Range("A1").PasteSpecial (xlPasteValues)
 
    Application.DisplayAlerts = False
    Workbooks("ETAT DE STOCKS_AUTOMATE.xls").Close
    Application.DisplayAlerts = True
 
    Set PlageRech = Sheets("VPC STANDARD").Range("A:A")
    With ThisWorkbook.Worksheets("STOCK")
        i = 2
        While .Cells(i, 2).Value <> ""
            Set c = PlageRech.Find(.Cells(i, 2), LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                FirstAddress = c.Address
                Do
                    NUM_PARUTION = .Cells(i, 1)
                    POIDS_PARUTION = .Cells(i, 4)
                    'STOCK
                        Sheets("VPC STANDARD").Range(FirstAddress).Offset(0, 11) = NUM_PARUTION
                        Sheets("VPC STANDARD").Range(FirstAddress).Offset(0, 12) = POIDS_PARUTION
                    Set c = PlageRech.FindNext(c)
                Loop While Not c Is Nothing And c.Address <> FirstAddress
            End If
            i = i + 1
        Wend
    End With
    Set PlageRech = Nothing
End Sub

merci pour vos pistes ou aides

david

**eriiic** · 16/10/2018, 23h40

Bonjour,

je ne vois pas trop le lien avec ton anomalie mais déjà il te manque une , devant LookIn:=
LookIn est le 3ème paramètre, pas le 2nd.
Bizarre que le compilateur ne t'ait rien dit.
eric

Edit : après une nuit de sommeil je vois que j'ai dit une bêtise :-)
Comme tes arguments sont nommés, pas besoin de les placer.

**munity** · 16/10/2018, 23h55

salut eriic

ben je souhaite ajouter chaque code article a chaque fois que necessaire
si designation = livre 1 se trouve sur 10 lignes (contigues ou non) alors recopie 10 fois du code article

merci de ton conseil mais effectivement pas de problème particulier à priori
j'ai réussi en modifiant le code je pense....

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


Sub test()
LePath = ActiveWorkbook.Path & "\"
ClasseurActif = ActiveWorkbook.Name

Application.Workbooks.Open LePath & "\ETAT DE STOCKS_AUTOMATE.xls" '

With Sheets("STOCK")
    ligne = .Cells(Rows.Count, 3).End(xlUp).Row
    .Range("b2:e" & ligne).Copy
End With
    Workbooks(ClasseurActif).Activate
    
    ActiveWorkbook.Worksheets.Add
    ActiveSheet.Name = "STOCK"
    Range("A1").PasteSpecial (xlPasteValues)
        
    Application.DisplayAlerts = False
    Workbooks("ETAT DE STOCKS_AUTOMATE.xls").Close
    Application.DisplayAlerts = True
    
    Sheets("VPC STANDARD").Activate
    
        With Sheets("STOCK")
            For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                Set PlageRech = Sheets("VPC STANDARD").Range("A:A")
                Set c = PlageRech.Find(.Cells(i, 2), lookat:=xlWhole)
                If Not c Is Nothing Then
                    FirstAddress = c.Address
                    Do
                        NUM_PARUTION = .Cells(i, 1)
                        POIDS_PARUTION = .Cells(i, 4)
                        ligne = Sheets("VPC STANDARD").Range("A" & .Rows.Count).End(xlUp).Row
                            For x = 2 To ligne
                               If Cells(x, 1) = c Then
                                        Sheets("VPC STANDARD").Cells(x, 12) = NUM_PARUTION
                                        Sheets("VPC STANDARD").Cells(x, 13) = POIDS_PARUTION
                                End If
                                
                            Next x
                        Set c = PlageRech.FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> FirstAddress
                End If
            Next i
        End With
        
    Set PlageRech = Nothing
    
End Sub

en rouge le code modifié qui me donne le résultat escompté

si d'autres méthodes je suis preneur évidemment

david

**Philippe Tulliez** · 17/10/2018, 06h48

Bonjour,
J'ai écrit une fonction basée sur la méthode Find qui renvoie dans une table toutes les cellules trouvées (objet Range) en fonction de deux paramètres.
Voir cette réponse https://www.developpez.net/forums/d1...et-listobject/

**RyuAutodidacte** · 17/10/2018, 09h44

Bonjour,

Envoyé par munity

en effet j'ai deux tableaux un fichier stock avec code et désignation
et un second ou je n'ai que la désignation
je cherche donc à récupérer le code pour mon second tableau
jusqu'ici tout va bien par contre si j'ai plusieurs désignation identiques, il ne me mets que la première

Dans ton 1er tableau (code/désignation) , y a-t-il des doublons ?
Dans ton 2è tableau les désignations sont elles écrites de manière identique partout ?

**munity** · 17/10/2018, 18h37

Bonjour ryu
Pour repondre a tes questions
Dans le tableau 1 ou je vais chercher mes codes en fonction de la designation il ny a aucun doublons et il ny en aura jamais car cest la liste unique de tous les articles
Et oui les designations ont la meme orthographe

**RyuAutodidacte** · 17/10/2018, 23h10

Re,

une autre façon de faire via une variable tableau et une collection
PS : il se peut qu'il y est une erreur, je l'ai fait en aveugle sans avoir les données à tester voir légèrement modifier si il le faut

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
Sub test()
Dim w_Actif As Workbook, w_Donnees As Workboo, VA, Coll As New Collection, i As Long, Lig As Long
 
    Set w_Actif = ThisWorkbook
 
    Set w_Donnees = Workbooks.Open(w_Actif.Path & "\ETAT DE STOCKS_AUTOMATE.xls")
    With w_Donnees
        With .Sheets("STOCK")
            VA = .Range("B2:E" & .Cells(.Rows.Count, 3).End(xlUp).Row).Value
        End With
        .Close False
    End With
    Set w_Donnees = Nothing
 
On Error Resume Next
    For i = LBound(VA) To UBound(VA)
        If VA(i, 2) > "" Then  'par précaution je ne connais pas les données - VA(i, 2) => désignation
            Coll.Add i, CStr(VA(i, 2)) ' enregistrement dans la collection de la ligne (i) dont l'index est le nom de la désignation -> CStr(VA(i, 2))
            If Err Then Err.Clear ' par précaution je ne connais pas les données
        End If
    Next
 
    With w_Actif
        '.Worksheets.Add:        .ActiveSheet.Name = "STOCK" ' <= Facultatif car utilsation d'une collection et d'un variable tableau
        With .Sheets("VPC STANDARD")
            Application.ScreenUpdating = False
 
                For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    Lig = Coll(CStr(.Cells(i, 1))) 'on vérifie que la "désignation" existe dans la collection
                    ' si y a pas d'erreur , on récupère la ligne  (LIig correspondante dans la variable tableau afin de récupérer les valeurs de NUM_PARUTION et POIDS_PARUTION
                    If Err Then
                        Err.Clear
                    Else
                        .Cells(i, 12) = VA(Lig, 1) ' NUM_PARUTION
                        .Cells(i, 13) = VA(Lig, 4) ' POIDS_PARUTION
                    End If
                Next
 
            Application.ScreenUpdating = True
        End With
 
    End With
On Error GoTo 0
    Set w_Actif = Nothing
End Sub

PS perso : Dédicace à Marc-L qui m'a beaucoup appris

**munity** · 18/10/2018, 01h39

Ok merci pour le code
Je vais le tester
En plus il doit etre plus rapide je pense
Je te tiens au courant
Merci encore

**RyuAutodidacte** · 18/10/2018, 11h11

Bonjour,

Pour l'emplacement des données, je l'ai fait par supposition.
En me précisant l'emplacement exact des données (classeurs et feuilles), on pourra ajuster si nécessaire.

Méthode find avec boucle

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager