Formule de calcul sous VB

Fermé
vash641 Messages postés 40 Date d'inscription lundi 20 avril 2009 Statut Membre Dernière intervention 6 janvier 2010 - 22 avril 2009 à 15:00
vash641 Messages postés 40 Date d'inscription lundi 20 avril 2009 Statut Membre Dernière intervention 6 janvier 2010 - 27 avril 2009 à 11:45
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
A voir également:

3 réponses

vash641 Messages postés 40 Date d'inscription lundi 20 avril 2009 Statut Membre Dernière intervention 6 janvier 2010
22 avril 2009 à 15:45
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
vash641 Messages postés 40 Date d'inscription lundi 20 avril 2009 Statut Membre Dernière intervention 6 janvier 2010
22 avril 2009 à 18:08
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
vash641 Messages postés 40 Date d'inscription lundi 20 avril 2009 Statut Membre Dernière intervention 6 janvier 2010
27 avril 2009 à 11:45
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