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
92
93
94
95
96
97
98
99
100
101
| Sub calcul_pmo()
Dim LastLig&
Dim Lastcol&
Dim S As Worksheet
Dim R As Range
Dim var
Dim couple(1 To 13) As Single
Dim i As Long
Dim j As Long
Dim Ld As Single
Dim Lq As Single
Dim Kt As Single
Dim CoupleAVide As Single
Dim CoupleCharge75 As Single
Dim CoupleCharge15 As Single
Dim CoupleCharge18 As Single
Dim CoupleCharge20 As Single
Dim CoupleCharge25 As Single
Dim CoupleCharge3 As Single
Dim CoupleNominal As Single
Set S = Sheets("Performances")
LastLig& = S.Cells.Find(What:="*", After:=[iv65536], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Lastcol& = S.Cells.Find(What:="*", After:=[iv65536], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set R = Range(S.Cells(1, 1), S.Cells(LastLig&, Lastcol&))
var = R
' chaque couple correspond à un tableau à couple constant
For i = 1 To 13
For j = 32 To 236 Step 17
'--- couple(13) = .Range("D237").Value ' valeur du couple nominal '237 au lieu de 236 ??? ---
If i = 13 Then j = j + 1
couple(i) = var(j, 4) 'j=ligne 4=colonne D
Next j
Next i
CoupleNominal = var(8, 4) 'ligne 8, colonne 4 (D)
CoupleAVide = 0
CoupleCharge75 = 0.75 * CoupleNominal
CoupleCharge15 = 1.5 * CoupleNominal
CoupleCharge18 = 1.8 * CoupleNominal
CoupleCharge20 = 2 * CoupleNominal
CoupleCharge25 = 2.5 * CoupleNominal
CoupleCharge3 = 3 * CoupleNominal
For i = 1 To 13 'boucle sur les 7 tableaux à couple constant
'calcul de Ld, Lq, Kt
If couple(i) = CoupleAVide Then
'=> valeur fixe, non fonction du couple
Ld = var(4, 15) 'O4
Lq = var(5, 15) 'O5
Kt = var(6, 15) 'O6
End If
If couple(i) > CoupleAVide And couple(i) < CoupleCharge75 Then
'fonction du couple
Ld = var(8, 15) * couple(i) + var(9, 15)
Lq = var(10, 15) * couple(i) + var(11, 15)
Kt = var(12, 15) * couple(i) + var(13, 15)
End If
If couple(i) >= CoupleCharge75 And couple(i) < CoupleNominal Then
'fonction du couple
Ld = var(8, 17) * couple(i) + var(9, 17)
Lq = var(10, 17) * couple(i) + var(11, 17)
Kt = var(12, 17) * couple(i) + var(13, 17)
End If
If couple(i) >= CoupleNominal And couple(i) < CoupleCharge15 Then
'fonction du couple
Ld = var(8, 19) * couple(i) + var(9, 19)
Lq = var(10, 19) * couple(i) + var(11, 19)
Kt = var(12, 19) * couple(i) + var(13, 19)
End If
If couple(i) >= CoupleCharge15 And couple(i) < CoupleCharge18 Then
'fonction du couple
Ld = var(8, 21) * couple(i) + var(9, 21)
Lq = var(10, 21) * couple(i) + var(11, 21)
Kt = var(12, 21) * couple(i) + var(13, 21)
End If
If couple(i) >= CoupleCharge18 And couple(i) < CoupleCharge20 Then
'fonction du couple
Ld = var(8, 23) * couple(i) + var(9, 23)
Lq = var(10, 23) * couple(i) + var(11, 23)
Kt = var(12, 23) * couple(i) + var(13, 23)
End If
If couple(i) >= CoupleCharge20 And couple(i) < CoupleCharge25 Then
'fonction du couple
Ld = var(8, 25) * couple(i) + var(9, 25)
Lq = var(10, 25) * couple(i) + var(11, 25)
Kt = var(12, 25) * couple(i) + var(13, 25)
End If
If couple(i) >= CoupleCharge25 Then
'fonction du couple
Ld = var(8, 27) * couple(i) + var(9, 27)
Lq = var(10, 27) * couple(i) + var(11, 27)
Kt = var(12, 27) * couple(i) + var(13, 27)
End If
'transfert des valeurs de Ld, Lq et Kt dans le tableau visual basic
j = (i - 1) * 17
If i = 13 Then j = j + 1
var(36 + j, 10) = Ld
var(36 + j, 9) = Lq
var(36 + j, 5) = Kt
Next i
'inscription du résultat
R = var
End Sub |
Optimisation d'un code
Répondre avec citation
Tutoriel :
Partager