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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
| Option Explicit
Const levelUnknown As Byte = 0
Const levelEmpty As Byte = 1
Const levelLow As Byte = 2
Const levelAverage As Byte = 6
Const levelHigh As Byte = 10
' Sheet target: "Travail à la référence"
Const rowPriceBegin = 25
Const rowPriceEnd = 30
Const colCaHt12mg = 8 ' H
Const colQtSell12 = 11 ' K
Const colPrice = 12 ' L
Const colLevel = 14 ' N
' Sheet source: "Perf"
Const strSheetPerf = "Perf"
Const rowSliceMin = 3
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngTmp As Range
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("H17,F25"), Target) Is Nothing Then
Application.EnableEvents = False
FrameSearch rowPriceBegin, LevelParse(Range("H17")), Val(Range("L25"))
Application.EnableEvents = True
ElseIf Not Intersect(Range("K25"), Target) Is Nothing Then
rngTmp = Target
With Application
.ScreenUpdating = False
.EnableEvents = False
.Undo
End With
Range("H25") = Range("H25") * rngTmp / Target
Range("I25") = Range("I25") * rngTmp / Target
Range("J25") = Range("J25") * rngTmp / Target
Target = rngTmp
Application.EnableEvents = True
End If
End Sub
Function LevelParse(ByVal strLevel As String) As Byte
Select Case strLevel
Case "bas"
LevelParse = levelLow
Case "moyen"
LevelParse = levelAverage
Case "haut"
LevelParse = levelHigh
Case ""
LevelParse = levelEmpty
Case Else
LevelParse = levelUnknown
End Select
End Function
Sub FrameSearch(ByVal rowPrice As Integer, ByVal levelCl As Byte, ByVal price As Integer)
Dim rngFindPrice As Range
If levelCl = levelEmpty Then
FrameClear rowPrice
ElseIf levelCl <> levelUnknown Then
Set rngFindPrice = Worksheets(strSheetPerf).Range("A:A").Find(price, _
LookIn:=xlValues, lookat:=xlWhole)
If rngFindPrice Is Nothing Then
FrameAverage rowPrice, levelCl, price
Else
FrameCopy rngFindPrice.Row, rowPrice
End If
End If
End Sub
Sub FrameClear(ByVal indRow As Integer)
Range(Cells(indRow, colCaHt12mg), Cells(indRow, colQtSell12)).ClearContents
End Sub
Sub FrameAverage(ByVal rowPrice As Integer, ByVal levelCl As Byte, ByVal price As Integer)
Dim indRow As Integer, indCol As Integer
Application.StatusBar = CStr(rowPrice) + " : tranche de prix inexistante," + _
"la moyenne des encadrants a été effectuée"
With Worksheets(strSheetPerf)
For indRow = rowSliceMin To .Range("A" & Rows.Count).End(xlUp).Row
If .Cells(indRow, 1) > price Then
For indCol = 0 To 3 ' Moyenne des encadrants
Cells(rowPrice, colCaHt12mg + indCol) = _
(.Cells(indRow - 1, levelCl + indCol) + _
.Cells(indRow, levelCl + indCol)) / 2
Next
Exit For
End If
Next
End With
End Sub
Sub FrameCopy(ByVal indRow As Integer, ByVal rowPrice As Integer)
Dim strRangeSrc As String
Select Case levelCl
Case levelLow
strRangeSrc = "B" & indRow & ":E" & indRow
Case levelAverage
strRangeSrc = "F" & indRow & ":I" & indRow
Case levelHigh
strRangeSrc = "J" & indRow & ":M" & indRow
Case Else
Exit Sub
End Select
Worksheets(strSheetPerf).Range(strRangeSrc).Copy _
Destination:=Range(Cells(rowPrice, colCaHt12mg), Cells(rowPrice, colQtSell12))
End Sub
Sub FrameAll()
Dim indRow As Integer, indCol As Integer, levelCl As Byte, price As Integer
Application.EnableEvents = False
For indRow = rowPriceBegin To rowPriceEnd
levelCl = LevelParse(Cells(indRow, colLevel))
price = Val(Cells(indRow, colPrice))
FrameSearch indRow, levelCl, price
Next
Application.EnableEvents = True
End Sub |
