VBA : erreur sur boucle

L

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:
Trier par date Trier par votes
C

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
 
Vote positif 0 Vote négatif
L

Latias

XLDnaute Nouveau
crocrocro à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
784
Aldonanou
A
J
  • Question
XL 2016 [RESOLU] Avis Code VBA excel
Réponses
9
Affichages
898
jabenj
J
S
  • Résolu(e)
XL 2010 non fonctionnement du code VBA sur un autre pc
Réponses
13
Affichages
2 K
Stedemart
S
N
  • Question
insertion d'un nombre variable de données dans une boucle
2
Réponses
17
Affichages
2 K
ninajams
N
M
  • Question
XL 2013 Erreur en fin de boucle ?
Réponses
2
Affichages
1 K
massol
M
M
  • Question
XL 2013 Erreur d'exécution 9 ou 13 que je n'arrive pas à résoudre.
2
Réponses
20
Affichages
3 K
massol
M
F
  • Question
Erreur sur boucle For
Réponses
3
Affichages
927
Florian53
F
C
  • Question
VBA les résultat de mon formulaire sur plusieurs feuilles
Réponses
3
Affichages
1 K
cylvain
C
X
  • Question
Afficher Résultats Macro (boucle If) dans Listbox sur feuille (non userform)
Réponses
9
Affichages
2 K
Xenors
X
J
  • Question
Problème avec la fonction Vlookup en VBA: erreur execution 9
Réponses
2
Affichages
1 K
julien1025
J

Membres actuellement en ligne

18 membres et 234 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 698
Messages
2 112 016
Membres
111 396
dernier inscrit
Baax