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
| Option Explicit
Const COLX As Integer = 2 'colonne des abscisses
Const COLY As Integer = 3 'colonne des températures
Const COL_PENTE As Integer = 4 'colonne d'affichage des pentes
Const FIRST_LINE As Integer = 15 'première ligne de données
Const NB_MOY_VAL As Integer = 3 'nombre de valeur surlesquel sont calculés la moyenne glissante
Private Sub CommandButton1_Click()
Dim LineMin As Long
Dim LineMax As Long
Dim LastLine As Long
LastLine = Cells(65000, COLY).End(xlUp).Row
Range(Cells(FIRST_LINE, COL_PENTE), Cells(LastLine, COL_PENTE)).ClearContents
LineMin = FIRST_LINE
LineMax = FIRST_LINE + 1
While LineMin < LineMax
LineMin = GetNextTMinLine(LineMin, LastLine)
LineMax = GetNextTMaxLine(LineMin, LastLine)
If LineMax <> LineMin Then
Cells(LineMin, COL_PENTE).Value = "<--Min"
Cells(LineMax, COL_PENTE).Value = "-->MAX : pente = " & WorksheetFunction.Slope(Range(Cells(LineMin, COLY), Cells(LineMax, COLY)), _
Range(Cells(LineMin, COLX), Cells(LineMax, COLX)))
LineMin = LineMax + 1
LineMax = LineMax + 2
End If
DoEvents
Wend
End Sub
Private Function GetNextTMinLine(ByVal lineBegin As Long, ByVal lineEnd As Long) As Long
Dim r As Range
Dim i As Long
Dim Count As Long
Set r = Range(Cells(lineBegin, COLY), Cells(lineBegin + NB_MOY_VAL - 1, COLY))
Count = lineEnd - lineBegin - NB_MOY_VAL
For i = 0 To Count
If WorksheetFunction.Sum(r.Offset(i)) < WorksheetFunction.Sum(r.Offset(i + 1)) Then Exit For
Next i
GetNextTMinLine = IIf(lineBegin + i + NB_MOY_VAL / 2 > lineEnd, lineEnd, lineBegin + i + NB_MOY_VAL / 2)
End Function
Private Function GetNextTMaxLine(ByVal lineBegin As Long, ByVal lineEnd As Long) As Long
Dim r As Range
Dim i As Long
Dim Count As Long
Set r = Range(Cells(lineBegin, COLY), Cells(lineBegin + NB_MOY_VAL - 1, COLY))
Count = lineEnd - lineBegin - NB_MOY_VAL
For i = 0 To Count
If WorksheetFunction.Sum(r.Offset(i)) > WorksheetFunction.Sum(r.Offset(i + 1)) Then Exit For
Next i
GetNextTMaxLine = IIf(lineBegin + i + NB_MOY_VAL / 2 > lineEnd, lineEnd, lineBegin + i + NB_MOY_VAL / 2)
End Function |
Partager