Optimisation boucle simple select Case

Bonjour à tous et à toutes,

Petite question, j'ai une base de données d'environ 10 000 lignes, et je souhaite éffectuer un simple calcul en fonction d'une cellule, aucun problème pour la boucle, mais le temps de traitement est relativement long... très long...

J'ai quand même une machine qui tourne pas mal avec 16Go RAM, le proc qui va bien .... mais cela mais plus de 10mn à s'effectuer alors pourriez vous m'aider ???

J'ai quand même un probleme, c'est que le programme s'arrête au niveau de la ligne 6120... (6000 et qqc je n'ai pas fait vraiment attention...) je crois que c'est normal pour Excel mais une idée pour contrer le phénomene ?

J'ai essayer avec le select case en premier et puis pour faire un essai je suis passé avec des if ... ElseIf, mais aucune différence sur le temps de traitement ...

Code:

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Sub calculPA()
 
DerLg = Sheets("Tarif 2022").Range("A" & Rows.Count).End(xlUp).Row
 
 
For i = 6000 To DerLg
 
    PPHT = Sheets("Tarif 2022").Range("M" & i)
    Fam = Sheets("Tarif 2022").Range("K" & i)
 
    'Select Case Fam
        'Case "PG 01"
 
        If Fam = "PG 01" Then
            PADum = PPHT - (PPHT * 20/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 02" Then
        'Case "PG 02"
            PADum = PPHT - (PPHT * 20.5/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 17" Then
        'Case "PG 17"
            PADum = PPHT - (PPHT * 23/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 03" Then
        'Case "PG 03"
            PADum = PPHT - (PPHT * 22/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 04" Then
        'Case "PG 04"
            PADum = PPHT - (PPHT * 28/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 05" Then
        'Case "PG 05"
            PADum = PPHT - (PPHT * 60/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 06" Then
        'Case "PG 06"
            PADum = PPHT - (PPHT * 78/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
 
        'Case "PG 07"
        ElseIf Fam = "PG 07" Then
            PADum = PPHT - (PPHT * 40/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 08" Then
        'Case "PG 08"
            PADum = PPHT - (PPHT * 28/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
 
        'Case "PG 13"
        ElseIf Fam = "PG 13" Then
            PADum = PPHT - (PPHT * 32/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 14" Then
        'Case "PG 14"
            PADum = PPHT - (PPHT * 45/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
 
        ElseIf Fam = "PG 15" Then
        'Case "PG 15"
            PADum = PPHT - (PPHT * 30 / 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        ElseIf Fam = "PG 18" Then
        'Case "PG 18"
            PADum = PPHT - (PPHT * 28.5/ 100)
            PADum = PADum - (PADum * 2.25 / 100)
            Sheets("Tarif 2022").Range("N" & i) = PADum
        End If
    'End Select
 
 
Next i
 
MsgBox "ok"
 
 
End Sub

Bonjour,

A tester:

Code:

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
Option Explicit
 
Sub calcul_PA()
    Dim DerLg As Long, kLg As Long, Fam As Integer, k As Single
    Dim CalculationMode As XlCalculation
    Sheets("Tarif  2022").Select
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    DerLg = Range("A" & Rows.Count).End(xlUp).Row
    For kLg = 6000 To DerLg
        Fam = Val(Mid(Range("K" & i), 2))
        k = 0
        If Fam = 1 Then k = 0.2
        ElseIf Fam = 2 Then k = 0.205
        ElseIf Fam = 3 Then k = 0.22
        ElseIf Fam = 4 Then k = 0.28
        ElseIf Fam = 5 Then k = 0.6
        ElseIf Fam = 6 Then k = 0.78
        ElseIf Fam = 7 Then k = 0.4
        ElseIf Fam = 8 Then k = 0.28
        ElseIf Fam = 13 Then k = 0.32
        ElseIf Fam = 14 Then k = 0.45
        ElseIf Fam = 15 Then k = 0.3
        ElseIf Fam = 17 Then k = 0.23
        ElseIf Fam = 18 Then k = 0.285
        End If
        If k <> 0 Then Range("N" & i) = 0.9775 * (1 - k) * Range("M" & i)
    Next i
    MsgBox "ok"
    Application.Calculation = CalculationMode
    Application.ScreenUpdating = True
End Sub

Cordialement.

1 pièce(s) jointe(s)

Et une autre façon de faire, sans VBA, utilisant une formule de calcul et un tableau contenant les coefficients à utiliser.
Cordialement.

ok

Bonjour,

Merci pour ton retour, effectivement, juste je n'aime pas utiliser les formules... et une fonction est plus exportable pour l'utiliser dans différent fichier.

Mon but était de faire une macro compléte en laissant le choix a l'utilisateur de rentrer sa propre formule ou coef, mais c'est une solution, je vais voir pour intégrer les formules via le VBA voir si cela est plus rapide... ?

Merci pour les temps accordé.

Une bonne journée.

EnjOy
:D:mouarf: