Formule de calcul sous VB

vash641 Messages postés 41 Statut Membre -  
vash641 Messages postés 41 Statut Membre -
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. vash641 Messages postés 41 Statut Membre
     
    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
  2. vash641 Messages postés 41 Statut Membre
     
    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
  3. vash641 Messages postés 41 Statut Membre
     
    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