'm_ValidationItems

Sub run_Week_Plus()

ThisWorkbook.Sheets("D").Cells(1, 1).Value = ThisWorkbook.Sheets("D").Cells(1, 1).Value + 1

End Sub

Sub run_Week_Minus()

ThisWorkbook.Sheets("D").Cells(1, 1).Value = ThisWorkbook.Sheets("D").Cells(1, 1).Value - 1

End Sub

Sub run_Validation_Item_Plus()

Call run_Validation_Item(1)

End Sub

Sub run_Validation_Item_Minus()

Call run_Validation_Item(-1)

End Sub

Sub run_Validation_Item(Optional ByVal intVal As Integer = 1)

'листаем список

ThisWorkbook.Activate

Const CONST_intCln_in_ar As Integer = 1

Dim rCell As Range

Dim rRange As Range

Dim aTemp As Variant

'считываем ячейку со списком

Set rCell = Range("PointVal") ' ThisWorkbook.Sheets("D").Cells(23, 2) 'ActiveCell

strValidation = Right(rCell.Validation.Formula1, Len(rCell.Validation.Formula1) - 1)

'считываем список

Set rRange = Range(strValidation) '.Value

aTemp = rRange.Value

Dim intRow_in_ar As Integer

intRow_in_ar = fun_each_val_in_ar(rCell.Value, aTemp, CONST_intCln_in_ar)

Select Case intVal

Case 1

If intRow_in_ar = UBound(aTemp) Then

intRow_in_ar = LBound(aTemp)

Else

intRow_in_ar = intRow_in_ar + 1

End If

Case -1

If intRow_in_ar = LBound(aTemp) Then

intRow_in_ar = UBound(aTemp)

Else

intRow_in_ar = intRow_in_ar - 1

End If

End Select

rCell.Value = aTemp(intRow_in_ar, CONST_intCln_in_ar)

End Sub

Function fun_each_val_in_ar(ByVal strVal As String, _

ByVal aTemp As Variant, _

Optional ByVal intColumn As Integer = 1) As Integer

For i = LBound(aTemp) To UBound(aTemp)

strTemp = aTemp(i, 1)

If strTemp = strVal Then GoTo fun_each_val_in_ar_Exit

Next i

fun_each_val_in_ar_Exit:

fun_each_val_in_ar = i

End Function