VBA : erreur sur boucle

Latias

XLDnaute Nouveau
Bonjour à tous,
Si vous pouvez me dépanner, cela ira plus vite, car je sèche un peu à trouver mon erreur.
Ma macro boucle sur les codes de mon inventaire, et pour chaque code, je calcule un prix moyen en fonction du stock et des quantités facturées.
Le problème, cela fonctionne bien pour le premier Code, arrivé au deuxième Code, la boucle cumul les factures des deux Codes et ainsi de suite.
Merci de votre aide

VB:
Sub INVENTAIRES()
  Application.ScreenUpdating = False   '   Geler l'affichage pendant le déroulement du code

Dim L, F, dernligneinv, dernlignefac As Long
Dim dateinv, datefac As Date
Dim codeinv, uniteinv, Message, Z As String
Dim quantiteinv, quantitefac, montantfac, nouvprix, codeproduitfac, uniteproduitfac, Chrono As Variant
Dim t, t1, t2 As Variant
Dim M, m1, m2 As Variant
Dim X, y As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Activate
dernligneinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Feuille STAT_Pesees")
   For L = 2 To 6 Step 1
              dateinv = .Cells(L, 1).Value     ' Colonne A
              codeinv = .Cells(L, 4).Value     ' Colonne D
             uniteinv = .Cells(L, 5).Value    '  Colonne E
          quantiteinv = .Cells(L, 6).Value    '  Colonne F
             nouvprix = .Cells(L, 8).Value    '  colonne H
            MsgBox "INV  " & dateinv & " _ " & codeinv & " _ " & quantiteinv & " _ " & uniteinv
'---------------------------------------------------------------------------------------------------------------------------------------
    Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Activate
    dernlignefac = Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
    With Worksheets("Liste")
        For F = dernlignefac To 2 Step -1
            'codeinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 4).Value
              datefac = .Cells(F, 8).Value     ' Colonne H pour les dates
           montantfac = .Cells(F, 10).Value    ' Montant HT de la ligne
          quantitefac = .Cells(F, 11).Value    ' Tonnage de la ligne
       codeproduitfac = .Cells(F, 4).Value
      uniteproduitfac = .Cells(F, 12).Value
               Chrono = .Cells(F, 7).Value
               'Message = (datefac & " _ " & Chrono & " _ " & codeproduitfac & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
                Message = ("FAC  " & datefac & " _ " & Chrono & " _ " & codeinv & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
               'Si la valeur en colonne D est identique au Code de l'inventaire ET si la date facture est <= à la date de l'inventaire
                  If codeproduitfac = codeinv And datefac <= dateinv Then
                        t = quantitefac + t
                        M = montantfac + M
                        Z = Message + Z
                        If t >= quantiteinv Then
                              t1 = quantiteinv - (t - quantitefac)
                              m1 = (montantfac / quantitefac) * t1
                              t2 = t - quantitefac
                              t = t - quantitefac + t1
                              m2 = M - montantfac
                              M = m1 + M - montantfac
                              y = M / t
                              Exit For
                       End If
                End If
        Next F
                If codeproduitfac <> codeinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Code produit non trouvé"
                ElseIf t < quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Le prix moyen ne peut être calculé"
                ElseIf t >= quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = Format(y, "#,##0.00")
                    MsgBox "Prix moyen  " & Format(y, "#,##0.00")
                End If
                MsgBox (Z)
    End With
   Next L
'---------------------------------------------------------------------------------------------------------------------------------------
End With
  Application.ScreenUpdating = True
End Sub
 
Dernière modification par un modérateur:

crocrocro

XLDnaute Occasionnel
Bonjour Latias,
ce serait mieux si vous fournissiez en plus du code, les fichiers utilisés, avec un jeux de données anonymisé et représentatif.
Pour plus de lisibilité de votre code, et donc vous permettre de trouver vos éventuelles erreurs , vous devriez l'indenter , comme ceci
Code:
Sub INVENTAIRES()
  Application.ScreenUpdating = False   '   Geler l'affichage pendant le déroulement du code

Dim L, F, dernligneinv, dernlignefac As Long
Dim dateinv, datefac As Date
Dim codeinv, uniteinv, Message, Z As String
Dim quantiteinv, quantitefac, montantfac, nouvprix, codeproduitfac, uniteproduitfac, Chrono As Variant
Dim t, t1, t2 As Variant
Dim M, m1, m2 As Variant
Dim X, y As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Activate
    dernligneinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Range("A" & Rows.Count).End(xlUp).Row
    With Worksheets("Feuille STAT_Pesees")
       For L = 2 To 6 Step 1
            dateinv = .Cells(L, 1).Value     ' Colonne A
            codeinv = .Cells(L, 4).Value     ' Colonne D
            uniteinv = .Cells(L, 5).Value    '  Colonne E
            quantiteinv = .Cells(L, 6).Value    '  Colonne F
            nouvprix = .Cells(L, 8).Value    '  colonne H
            MsgBox "INV  " & dateinv & " _ " & codeinv & " _ " & quantiteinv & " _ " & uniteinv
    '---------------------------------------------------------------------------------------------------------------------------------------
            Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Activate
            dernlignefac = Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
            With Worksheets("Liste")
                For F = dernlignefac To 2 Step -1
                    'codeinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 4).Value
                    datefac = .Cells(F, 8).Value     ' Colonne H pour les dates
                    montantfac = .Cells(F, 10).Value    ' Montant HT de la ligne
                    quantitefac = .Cells(F, 11).Value    ' Tonnage de la ligne
                    codeproduitfac = .Cells(F, 4).Value
                    uniteproduitfac = .Cells(F, 12).Value
                    Chrono = .Cells(F, 7).Value
                    'Message = (datefac & " _ " & Chrono & " _ " & codeproduitfac & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
                    Message = ("FAC  " & datefac & " _ " & Chrono & " _ " & codeinv & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
                    'Si la valeur en colonne D est identique au Code de l'inventaire ET si la date facture est <= à la date de l'inventaire
                    If codeproduitfac = codeinv And datefac <= dateinv Then
                         t = quantitefac + t
                         M = montantfac + M
                         Z = Message + Z
                         If t >= quantiteinv Then
                               t1 = quantiteinv - (t - quantitefac)
                               m1 = (montantfac / quantitefac) * t1
                               t2 = t - quantitefac
                               t = t - quantitefac + t1
                               m2 = M - montantfac
                               M = m1 + M - montantfac
                               y = M / t
                               Exit For
                        End If
                    End If
                Next F
                If codeproduitfac <> codeinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Code produit non trouvé"
                ElseIf t < quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Le prix moyen ne peut être calculé"
                ElseIf t >= quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = Format(y, "#,##0.00")
                    MsgBox "Prix moyen  " & Format(y, "#,##0.00")
                End If
                MsgBox (Z)
            End With
       Next L
    '---------------------------------------------------------------------------------------------------------------------------------------
    End With
    Application.ScreenUpdating = True
End Sub
 

Latias

XLDnaute Nouveau
Bonjour Latias,
ce serait mieux si vous fournissiez en plus du code, les fichiers utilisés, avec un jeux de données anonymisé et représentatif.
Pour plus de lisibilité de votre code, et donc vous permettre de trouver vos éventuelles erreurs , vous devriez l'indenter , comme ceci
Code:
Sub INVENTAIRES()
  Application.ScreenUpdating = False   '   Geler l'affichage pendant le déroulement du code

Dim L, F, dernligneinv, dernlignefac As Long
Dim dateinv, datefac As Date
Dim codeinv, uniteinv, Message, Z As String
Dim quantiteinv, quantitefac, montantfac, nouvprix, codeproduitfac, uniteproduitfac, Chrono As Variant
Dim t, t1, t2 As Variant
Dim M, m1, m2 As Variant
Dim X, y As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Activate
    dernligneinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Range("A" & Rows.Count).End(xlUp).Row
    With Worksheets("Feuille STAT_Pesees")
       For L = 2 To 6 Step 1
            dateinv = .Cells(L, 1).Value     ' Colonne A
            codeinv = .Cells(L, 4).Value     ' Colonne D
            uniteinv = .Cells(L, 5).Value    '  Colonne E
            quantiteinv = .Cells(L, 6).Value    '  Colonne F
            nouvprix = .Cells(L, 8).Value    '  colonne H
            MsgBox "INV  " & dateinv & " _ " & codeinv & " _ " & quantiteinv & " _ " & uniteinv
    '---------------------------------------------------------------------------------------------------------------------------------------
            Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Activate
            dernlignefac = Workbooks("BD_GESTION_FACTURES_FOURNISSEURS_(PC)").Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
            With Worksheets("Liste")
                For F = dernlignefac To 2 Step -1
                    'codeinv = Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 4).Value
                    datefac = .Cells(F, 8).Value     ' Colonne H pour les dates
                    montantfac = .Cells(F, 10).Value    ' Montant HT de la ligne
                    quantitefac = .Cells(F, 11).Value    ' Tonnage de la ligne
                    codeproduitfac = .Cells(F, 4).Value
                    uniteproduitfac = .Cells(F, 12).Value
                    Chrono = .Cells(F, 7).Value
                    'Message = (datefac & " _ " & Chrono & " _ " & codeproduitfac & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
                    Message = ("FAC  " & datefac & " _ " & Chrono & " _ " & codeinv & " _ " & montantfac & " € _ " & quantitefac & " _ " & uniteproduitfac & Chr(10))
                    'Si la valeur en colonne D est identique au Code de l'inventaire ET si la date facture est <= à la date de l'inventaire
                    If codeproduitfac = codeinv And datefac <= dateinv Then
                         t = quantitefac + t
                         M = montantfac + M
                         Z = Message + Z
                         If t >= quantiteinv Then
                               t1 = quantiteinv - (t - quantitefac)
                               m1 = (montantfac / quantitefac) * t1
                               t2 = t - quantitefac
                               t = t - quantitefac + t1
                               m2 = M - montantfac
                               M = m1 + M - montantfac
                               y = M / t
                               Exit For
                        End If
                    End If
                Next F
                If codeproduitfac <> codeinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Code produit non trouvé"
                ElseIf t < quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = "Le prix moyen ne peut être calculé"
                ElseIf t >= quantiteinv Then
                    Workbooks("PILOTAGE FICHIERS").Sheets("Feuille STAT_Pesees").Cells(L, 8).Value = Format(y, "#,##0.00")
                    MsgBox "Prix moyen  " & Format(y, "#,##0.00")
                End If
                MsgBox (Z)
            End With
       Next L
    '---------------------------------------------------------------------------------------------------------------------------------------
    End With
    Application.ScreenUpdating = True
End Sub
Merci pour le retour, effectivement cela est pertinent pour la lecture du code ; à faire pour les prochaines fois.
J'ai testé une dernière fois avec ce bout de code en fin de macro et cela semble fonctionner.

End With
Z = ""
t = 0
M = 0
Next L
End With
Application.ScreenUpdating = True
End Sub

Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 554
Messages
2 089 535
Membres
104 205
dernier inscrit
mehaya63