Code:
Sub Ciclo()
NumS = 0
Columns("H:I").ClearContents
Num = 1
Vmin = 1000
RMax = 5
Vmax = 0
Dn = Cells(Rows.Count, "B").End(xlUp).Row
Vmin = Cells(5, 2).Value
Vmax = Cells(5, 2).Value
For Each cell In Range("B6:B" & Dn)
If Num = 1 Then
If cell < Vmin Then
Vmin = cell
RMin = cell.Row
End If
If cell >= Vmax Then
Vmax = cell
RMax = cell.Row
End If
If Not Cells(cell.Row, 8) = 3 Then
If cell > cell.Offset(1, 0) Then
If cell >= cell.Offset(2, 0) Then
If cell >= cell.Offset(3, 0) Then
If Cells(RMax, 8) = 0 Then
Cells(RMax, 8) = 2
Cells(RMax, 9) = 2
Cells(RMax + 1, 8) = 3
Cells(RMax + 1, 9) = 3
Else
Cells(RMax, 9) = """ 1 - 2"
Cells(RMax + 1, 8) = 3
Cells(RMax + 1, 9) = 3
End If
'-------------------------
If Cells(RMax + 1, 2) < Cells(RMax + 2, 2) Then
If Cells(RMax + 2, 2) < Cells(RMax + 3, 2) Then
If Cells(RMax + 3, 2) < Cells(RMax + 4, 2) Then
Cells(RMax + 1, 8) = 4
Cells(RMax + 1, 9) = """ 3 - 4"
Cells(RMax + 2, 8) = 1
Cells(RMax + 2, 9) = 1
Vmin = 1000
Vmax = 0
RMax = RMax + 2
Num = 1
GoTo 10
End If
End If
End If
'-------------------------
NumS = cell
Vmin = 1000
Vmax = 0
Num = Num + 1
End If
End If
End If
End If
Else
Riga = RMax
If Not Cells(cell.Row - 1, 8) = 2 Then
If Not Cells(cell.Row, 8) = 3 Then
If cell < cell.Offset(-1, 0) Then
If cell < cell.Offset(1, 0) Then
If cell >= cell.Offset(2, 0) Then
If cell >= cell.Offset(3, 0) Then
If cell >= cell.Offset(4, 0) Then
'--------------------------------------
XX = 0
If cell < cell.Offset(1, 0) Then XX = 1
If cell < cell.Offset(2, 0) Then XX = 1
If XX = 1 Then GoTo 10
'--------------------------------------
Cells(cell.Row, 8) = 4
Cells(cell.Row + 1, 8) = 1
Vmin = cell.Offset(1, 0)
Vmax = cell.Offset(1, 0)
RMax = Riga + 1
Num = 1
GoTo 10
End If
End If
End If
End If
End If
For Each cellx In Range("B" & cell.Row & ":B" & cell.Row + 14)
If cellx.Offset(-1, 0) > cellx Then
If cellx.Offset(1, 0) > cellx Then
If cellx.Offset(2, 0) > cellx Then
If cellx.Offset(3, 0) > cellx Then
Riga = cellx.Row
Exit For
End If
End If
End If
End If
Next
If cell.Row = Riga Then
Cells(Riga, 8) = 4
Cells(Riga, 9) = 4
Cells(Riga + 1, 8) = 1
Cells(Riga + 1, 9) = 1
Vmin = cell.Offset(1, 0)
Vmax = cell.Offset(1, 0)
RMax = Riga + 1
Num = 1
End If
End If
End If
End If
10
Next
End Sub
I have yet to finish the tests, ask advice
Bookmarks