VBA : boucle for + boucle do problème

Version imprimable

Bonjour,

Je poste sur ce forum car j'ai un problème pour finaliser une macro. Je vous explique le problème

J'ai une liste de commande fournisseur, je souhaiterais à travers une macro vba récupérer les numéro de commande et les montants associés et les copié dans un onglet à la ligne correspondante. Il y a souvent plusieurs commande pour un même fournisseur. dans ce cas je voudrais qu'il copie la commande et le montant dans les colonnes d'après (colonne 18+3 pour les numéros de commandes et 20+3 sur les montant associés.

J'ai un problème avec la gestion de mes boucles qui fait que finalement il ne copie rien dans les colonnes suivantes si il y a des commandes qui correspondent au même fournisseur.

Je vous joins la partie du code qui ne fonctionne pas.

Je vous remercie d'avance et vous promets d'être assidu sur ce forum pour vous aider si les membres en ont besoin.
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 Sheets("TCD").Select For i = 3 To nombre_lignes Sheets("TCD").Select Application.StatusBar = " Traitement de l'opération " & i & "/" & nombre_lignes Numero_CE = Cells(i, 16).Value Numero_CDE = Cells(i, 17).Value Fournisseur = Cells(i, 18).Value Montant_CDE = Cells(i, 19).Value Sheets("base de donnée").Select nombre_lignes_BDD = Range("A65536").End(xlUp).Row For j = 2 To nombre_lignes_BDD If Cells(j, 3).Value = Numero_CE And Cells(j, 6).Value = Fournisseur Then k = 18 l = 20 Do k = k + 3 If IsEmpty(Cells(j, k)) Then Cells(j, k).Value = Numero_CDE End If Loop While IsEmpty(Cells(j, k)) Do l = l + 3 If IsEmpty(Cells(j, l)) Then Cells(j, l).Value = Montant_CDE End If Loop While IsEmpty(Cells(j, l)) End If Next j Next i End Sub

Peut être comme ceci (pas testé)

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
Sub Test()
Dim Numero_CE As String, Numero_CDE As String, Fournisseur As String
Dim Nombre_Lignes As Long, Nombre_Lignes_BDD As Long
Dim i As Long, j As Long, k As Long
Dim Montant_CDE As Double
 
Application.ScreenUpdating = False
With Sheets("base de donnée")
    Nombre_Lignes_BDD = .Cells(.Rows.Count, 3).End(xlUp).Row
End With
 
With Sheets("TCD")
    Nombre_Lignes = .Cells(.Rows.Count, 16).End(xlUp).Row
    For i = 3 To Nombre_Lignes
        Application.StatusBar = " Traitement de m'opération " & i & "/" & Nombre_Lignes
        Numero_CE = .Cells(i, 16).Value
        Numero_CDE = .Cells(i, 17).Value
        Fournisseur = .Cells(i, 18).Value
        Montant_CDE = Val(Replace(.Cells(i, 19).Value, ",", "."))
 
        With Sheets("base de donnée")
            For j = 2 To Nombre_Lignes_BDD
                If .Cells(j, 3).Value = Numero_CE And .Cells(j, 6).Value = Fournisseur Then
                    k = 18
                    Do Until .Cells(j, k) = ""
                        k = k + 3
                    Loop
                    .Cells(j, k).Value = Numero_CDE
                    .Cells(j, k + 2).Value = Montant_CDE
                    Exit For
                End If
            Next j
        End With
    Next i
End With
End Sub

14/02/2012, 10h50
antoineDG

Merci de ta réponse ! J'essaie cela ce soir et je te tiens au courant.
14/02/2012, 10h54
mercatog

Ajoute à la fin juste avant le End Sub cette ligne

Code:

Application.StatusBar =""
15/02/2012, 06h58
AlainTech

Bonjour Mercatog,

Je pense qu'il vaut mieux mettre

Code:

Application.StatusBar = False

Sinon, tu perds les fonctionnalités normales de la Status Bar.
15/02/2012, 11h19
mercatog

Bonjour Alain
Effectivement tu as raison. :ccool: