Discussion :

[bricko]

Bonjour à la communauté.
J'ai un gros soucis avec une macro de calcul d'un coût de transport.
En fait dans la 3ème feuille ("table as_is"); j'ai toutes les livraisons effectuées à partir de 3 villes polonaises.

Dans la feuill1 j'ai le prix à appliquer pour chacune des livraisons en respectant un certain tonnage et en étant dans une certaine range de kilomètres.

En voulant exécuter la macro; je n'ai pas le résultat espérer: cad avoir le coût dans la colonne TransportCost in PLN qui se trouve dans la feuille ("table As_is")

Chose encore bizarre, quand j'essaie de faire le calcul pour un site à la fois, la macro s'avère efficace et j'arrive à calculer le prix appliqué à chaque livraison si celle-ci se trouve respecter les closes définies dans la feuill1.

Merci de m'aider, j'aimerais ne pas à avoir appliquer la macro sur un site à la fois (ça serait lourd vu que je dois traiter plusieurs sites à la fois; ici j'en ai que 3 mais c'est juste un petit exemple pour illustrer mon propos)

Les macros sont sommairement commentés mais je suis près à les réexpliquer.
Je tiens d'ailleurs à remercier Daniel.C qui m'a aider sur le coup.

[bricko]

Bonjour à tous;
Je vais reposter un fichier modifié en quelque sorte pour illustrer ma difficulté.
Le problème que je rencontre actuellement c'est que je n'arrive toujours pas à calculer le coût transport pour une livraison donnée.

La macro se trouvant dans le module standard devrait aller chercher une livraison quelconque dans la feuille ("table AS_IS"), chercher une correspondance de prix dans la feuille ("outCost"). La recherche de cette correspondance est assez longue car dès le début de la macro on charge toute la feuille OutCost et on la parcours,dès qu'on trouve une correspondance on marque le prix.

Toute aide serait appréciée .
Un bon week-end.

[Daniel.C]

Bonjour,

Chose encore bizarre, quand j'essaie de faire le calcul pour un site à la fois, la macro s'avère efficace et j'arrive à calculer le prix appliqué à chaque livraison si celle-ci se trouve respecter les closes définies dans la feuill1.

Est-ce que tu peux détailler ce qui ne va pas ? Comment est-ce que tu fais le calcul pour un seul site ? La macro événementielle "Worksheet_Change" de la feuille "table AS_IS" ne peut pas fonctionner en l'état.Tu devrais l'enlever dans un premier temps.

[bricko]

Bonjour Daniel.C,
en fait ce qui se passe c'est que dans la feuille("table As_is") j'ai plusieurs livraisons en provenance de plusieurs endroits de Pologne.
Dans ma feuille OutCost, j'ai le prix en zlotis à appliquer pour un certain range de kilométrage et un certain range de tonnage.

Les livraisons qui sont dans la table As_Is ne sont pas triées. Un coup, j'ai Dabrowa, un autre coup j'ai Gdansk.

Du coup, quand je prends la 1ère ligne de la feuille table as_is, la macro va chercher une correspondance dans la table out_cost et se retrouve à chercher dans plusieurs villes différentes.

je ne sais si je suis claire mais je tiens à votre disposition pour toute explication supplémentaire.

(Re) bonjour,
en suivant votre conseil Mr Daniel.C (en supprimant la macro événementiel de la feuill1); je n'ai pas toujours la réponse espérée.

Merci encore une fois de votre aide.

[BlueMonkey]

Salut,

En faisant For Each C In .Range(.[A2], .Cells(.Rows.Count,1).End(xlUp)).Offset(, 6).
tu parcours toutes les cellules de la plage A2:G4439.
Alors que visiblement tu souhaites faire un calcul par ligne ...

Un autre problème est que les cellules contenant des dates n'ont pas été formaté en tant que telle

Tant qu'a utiliser les tableaux, essaye :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
'Calcul de la colonne AC de la feuille Calcul
Sub Calcul()
    Dim TabGamme As Variant, i As Long, gi As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        'Chargement en mémoire de la plage A2:Mxx de la feuille "Out cOST"
        ' dans le but de gagner du temps
        TabGamme = .Range(.[A2], .Cells(.Rows.Count, 13).End(xlUp))
    End With
 
    'Boucle sur toutes les lignes de la feuille "table AS_IS"
    With Sheets("table AS_IS")
        Const FirstLine As Integer = 2
        Dim lastLine As Long:  lastLine = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim TabVille As Variant: TabVille = .Range("A" & FirstLine & ":A" & lastLine)
        Dim TabPays As Variant: TabPays = .Range("B" & FirstLine & ":B" & lastLine)
        Dim TabCp As Variant: TabCp = .Range("C" & FirstLine & ":C" & lastLine)
        Dim TabDate As Variant: TabDate = .Range("D" & FirstLine & ":D" & lastLine)
        Dim TabPoids As Variant: TabPoids = .Range("E" & FirstLine & ":E" & lastLine)
        Dim TabDist As Variant: TabDist = .Range("F" & FirstLine & ":F" & lastLine)
        Dim TabResultat As Variant: TabResultat = .Range("AC" & FirstLine & ":AC" & lastLine)
 
 
        For i = 1 To (lastLine - FirstLine + 1)
            TabResultat(i, 1) = ""
            'Pour chaque ligne on teste les lignes de TabGamme jusqu'à trouver la bonne
            Dim dateExpe As Date: dateExpe = CDate(TabDate(i, 1))
 
            For gi = 1 To UBound(TabGamme, 1)
                'si c'est la bonne ville et le bon pays
                If TabVille(i, 1) = TabGamme(gi, 1) And TabPays(i, 1) = TabGamme(gi, 2) Then
                'si on est dans la bonne plage de codes postaux
                    If Left(TabCp(i, 1), 2) >= TabGamme(gi, 3) And Left(TabCp(i, 1), 2) <= Left(TabGamme(gi, 4), 2) Then
                        ' si on est dans la bonne plage de dates
                        If dateExpe >= CDate(TabGamme(gi, 5)) And dateExpe <= CDate(TabGamme(gi, 6)) Then
                            'si on est dans la bonne plage de tonnage
                            If TabPoids(i, 1) >= TabGamme(gi, 7) And TabPoids(i, 1) <= TabGamme(gi, 8) Then
                                'si on est dans la bonne plage de km
                                If TabDist(i, 1) >= TabGamme(gi, 9) And TabDist(i, 1) <= TabGamme(gi, 10) Then
                                    'on calcule
                                    TabResultat(i, 1) = TabGamme(gi, 11) * TabPoids(i, 1) + _
                                                        TabGamme(gi, 12) * TabDist(i, 1)
                                    'et on sort de la boucle d'examen des lignes de la table
                                    Exit For
                                End If
                            End If
                        End If
                    End If
                End If
            Next gi
        Next i
 
        .Range("AC2:AC" & lastLine) = TabResultat
    End With
    Application.ScreenUpdating = True
End Sub

A+

[bricko]

Bonjour BleuMonkey ,
Votre macro semble très bien fonctionner.
J'aurais une question très pratique.
Devrais-je laisser la macro événementielle qui se trouve dans feuill1.
Je vous rappelle qu'elle permet de calculer au fil de l'eau, les lignes supplementaires qui seraient ajouter dans la table As_IS.

Merci pour votre aide précieuse.

Un autre problème est que les cellules contenant des dates n'ont pas été formaté en tant que telle

Je ne comprends pas cette phrase par rapport aux dates

[BlueMonkey]

Re,

Le code que posté précédemment n'utilise pas la macro évènementielle pour des calcul intermédiaire.
Mais si elle permet de calculer les résultats au fils de l'eau, la mise à jour sera plus rapide que de recalculer toute la feuille.

A noter que certaines plages de distances ne sont pas continue avec les plages suivantes (ex : l'une fini à 100, l'autre recommence à 101).


[Edit] Par rapport aux dates, je voulais dire que le format des cellules contenant des dates utilisent un format Texte. (pas date)

Du coup, les calculs sans conversion de texte en date risque d'être faux.

[bricko]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Option Explicit
 
'même principe de calcul
'la macro se déclenche dès qu'on modifie la valeur d'une cellule
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Tabl As Variant, C As Range, i As Long, Valid As Boolean
    'si la cellule modifiée ("Target") n'est pas dans les colonnes A:F, arrêt de la macro
    If Intersect(Target, [A:F]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    'si toutes les cellules  de la ligne sont renseignées
    If Application.WorksheetFunction.CountA(Range(Cells(Target.Row, 1), Cells(Target.Row, 6))) = 6 Then
        'calcul du résultat pour la ligne (voir la macro "Calcul")
        With Sheets("Feuil1")
            Tabl = .Range(.[A2], .Cells(.Rows.Count, 13).End(xlUp))
        End With
        With Sheets("table AS_IS")
            For Each C In Target
                Valid = False
            For i = 1 To UBound(Tabl, 1)
                If .Cells(C.Row, 1) = Tabl(i, 1) And .Cells(C.Row, 2) = Tabl(i, 2) Then
                    If Left(.Cells(C.Row, 3), 2) >= Tabl(i, 3) And Left(.Cells(C.Row, 3), 2) <= Left(Tabl(i, 4), 2) Then
                        If .Cells(C.Row, 4) >= Tabl(i, 5) And .Cells(C.Row, 4) <= Tabl(i, 6) Then
                            If .Cells(C.Row, 5) >= Tabl(i, 7) And .Cells(C.Row, 5) <= Tabl(i, 8) Then
                                If .Cells(C.Row, 6) >= Tabl(i, 9) And .Cells(C.Row, 6) <= Tabl(i, 10) Then
                                    .Cells(C.Row, 29) = Tabl(i, 11) * .Cells(C.Row, 5) + _
                                        Tabl(i, 12) * .Cells(C.Row, 6)
                                        Valid = True
                                    Exit For
                                End If
                            End If
                        End If
                    End If
                End If
            Next i
                If Not Valid Then .Cells(C.Row, 29) = "not in contract"
            Next C
        End With
     End If
      Application.EnableEvents = True
      Application.EnableEvents = True
End Sub

Ci-dessus le code qui me permet de calculer au fil de l'eau tout changement apporté à la feuille table As_is

Exacte je viens de voir pour les dates; vous avez raisons je viens de le corriger.
Pour le problème de discontinuité; ce n'est pas vraiment un souci, le classeur que j'ai posté est un sort d'exemple pour illustrer mon problème.
J'ai fais des copier-coller sans vraiment me soucier des intervalles.

Je tiens à vous remercier tout particulièrement BlueMonkey et Daniel.C pour votre promptitude à répondre à mes questions.

Je tiens à dire que je suis nouveau sur le forum et j'avoue que j'adore comment les gens réagissent de manière assez rapide.

Je suis assez nouveau en vba (mais ça vous l'avez remarqué)
Est-ce que par hasard vous auriez des tutoriels à conseiller.

Merci encore de votre aide