Formule de calcul sous VB

Bonjour, j'ais un souci concernant un code de calcul à faire un tantinet ardu pour mes neurones.

Ci joint le fichier excel https://www.cjoint.com/?eyeCXhavRH

Premier petit souci, je souhaiterais que lorsque que clique sur le bouton, les procédures de la feuille "articles", "fournitures" et "Prix totaux" s'exécutent.

Second souci, je dois afficher dans la feuille "prix totaux", pour chaque fourniture, le prix que coutera chaque fourniture, sachant que certaines sont dans plusieurs articles, qu'elles doivent être calculer que si l'article est coché feuille "articles" et qu'il faut tenir compte du prix à l'unité de la fourniture et de la quantité qui est spécifié dans l'article.

Pour être plus clair, un exemple:

Article 1 et 3 coché, quantité respective 3 et 20.
-Fourniture 1,2 et 3 associées à l'article 1, de prix à l'unité respectivement de 25.4, 67 et 2.1 ( donc à multiplier par 3 puisque la quantité dans l'article 1 est de 3 )
-Fourniture 1 et 6 associées à l'article 3, de prix à l'unité respectivement de 25.4 et 800 ( donc à multiplier par 20 puisque la quantité dans l'article 3 est de 20 )

Donc pour les cases "fourniture 1", "fourniture 2", "fourniture 3" et "fourniture 6" de la feuille "prix totaux" il devra y avoir respectivement 584.2, 201, 6.3 et 16000.

J'ais tenté divers boucles, mais étant débutant je me suis un peu perdu dans les boucles et les indices ...

Sub CaculPrixFourniture1()

Dim F1 As Integer
F1 = 0
F2 = 0



  For J = 2 To 11
    For I = 2 To 13
        
           If Cells(I, 3).Value = "Fourniture 1" Then
            If Worksheets("Articles").Cells(I, 4).Value = 1 Then
            F2 = F2 + Worksheets("Articles").Cells(I, 3) * Cells(I, 5) * Cells(I, 6)
            F1 = F1 + F2
           End If
            End If
Worksheets("Prix totaux").Cells(2, 3).Value = F1
Worksheets("Prix totaux").Cells(2, 4).Value = F2
  Next I
 Next J

End Sub


Cordialement

3 réponses

  1. Bon, j'ais tenté de coder mon calcul dans un premier temps pour "fourniture1" mais il me retourne un résultat négatif ( -550 ) et je comprend pas du tout d'ou il me sort cette valeur.

    Sub CalculFourniture1()
    
    Dim i As Integer
    Dim Compt As Integer
    Dim ComptA As Integer
    Dim F1 As Integer
    F1 = 0
    
    ComptA = Worksheets("Articles").Range("C65536").End(xlUp).Row
     Cells(1, 3) = ComptA
        
    Compt = Worksheets("Fournitures").Range("D65536").End(xlUp).Row
        
     Cells(1, 4) = Compt
     
     
        For j = 2 To ComptA - 1
        
            For i = 2 To Compt - 1
    
                If Worksheets("Fournitures").Cells(i, 3).Value = "Fourniture 1" Then
                F1 = F1 + (Worksheets("Articles").Cells(j, 3) * Worksheets("Fournitures").Cells(i, 5) * Worksheets("Fournitures").Cells(i, 6))
                End If
                Cells(2, 3) = F1
                
            Next i
        Next j
    
    End Sub


    Une idée ?
    0
    1. J'ais résolu mon souci de signe négatif ( true vaut -1 ) mais je n'arrive pas à trouver mon erreur au niveau de la valeur qu'il me renvoit dans la boucle :/
      0
      1. Petit up du topic, le code suivant fait bien ce qu'il faut, mais il prend énormément de temps ( ComptPT et ComptA valant 2001 et 160 )

        Je souhaiterais qu'il soit plus rapide à exécuter, auriez vous une piste à me donner ? ( sachant qu'il y a plein d'itérations ou rien ne se passe, j'aimerais faire un test mais je ne vois pas trop ou :s

        'A optimiser, trop de temps pour calculer le prix total en l'état

        Sub CalculFournitures()
        
        Dim i As Integer
        Dim Compt As Integer
        Dim ComptA As Integer
        Dim F1 As Variant
        
        F1 = 0
        k = 2
        j = 2
        i = 2
        
        ComptA = Worksheets("Articles").Range("C65536").End(xlUp).Row
        Cells(1, 4) = ComptA
            
        ComptF = Worksheets("Fournitures").Range("D65536").End(xlUp).Row
        Cells(1, 3) = ComptF
         
        ComptPT = Worksheets("Prix totaux").Range("B65536").End(xlUp).Row
        Cells(1, 5) = ComptPT
        
        'For k = 2 To ComptPT   'indice de la ligne où est la fourniture dans la page Prix total
        
        For k = 2 To ComptPT
        
            For j = 2 To ComptA  'indice de l'article
            
                For i = 2 To ComptPT 'indice de la fourniture dans l'article
                    
                        If Worksheets("Fournitures").Cells(i, 1).Value = Worksheets("Prix totaux").Cells(k, 1).Value And j - 1 = Worksheets("Fournitures").Cells(i, 2).Value Then
                        F1 = F1 + (Worksheets("Articles").Cells(j, 4).Value * Worksheets("Fournitures").Cells(i, 5).Value * Worksheets("Fournitures").Cells(i, 6).Value)
                        End If
                                
                    Worksheets("Prix totaux").Cells(k, 4).Value = F1
                    'Cells(2, 8) = Worksheets("Articles").Cells(j, 4).Value 'quantité
                    'Cells(2, 9) = Worksheets("Fournitures").Cells(i, 5).Value 'actif ou pas
                    'Cells(2, 10) = Worksheets("Fournitures").Cells(i, 6).Value 'prix unitaire
                    'Cells(2, 11) = Worksheets("Fournitures").Cells(i, 3).Value 'N°article
                    'Cells(2, 12) = Worksheets("Prix totaux").Cells(k, 1).Value 'N° fourniture
                    Cells(1, 8) = i
                    Cells(1, 9) = j
                    Cells(1, 10) = k
                    
                        If j = ComptA And i = ComptPT Then
                        Worksheets("Prix totaux").Cells(k + 1, 4).Value = "0"
                        F1 = Worksheets("Prix totaux").Cells(k + 1, 4).Value
                        End If
                                    
                Next i
                
            Next j
        
        Next k
        
        End Sub


        Je ne peux pas joindre le excel correspondant ( >500 Ko )

        En espérant une tit piste de votre part ( je pensais à faire un while, mais je vois pas trop ou et comment )
        0