Ниже приведено требование к достижению в Excel с помощью программы VBA
Пользователь вводит интервал времени в минутах, например, 30: 30 минут.
Когда пользователь убирает фокус с ячейка, содержимое в ячейке должно измениться на почасовой формат. В этом случае это значение равно .50, поскольку 30 минут эквивалентны .50 часам.
Если пользователь сохраняет фокусировку на этой ячейке, содержимое ячейки должно снова измениться на 30. И если пользователь перемещает фокус за пределы этой ячейки, содержимое ячейки должно снова измениться на .50. Тот же процесс должен повторяться до тех пор, пока пользователь перемещает фокус в или из этой ячейки.
Вот мой текущий код. Но этот код работает только один раз. Если я перемещаю фокус за пределы ячейки или внутри ячейки во второй раз, он не работает.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Set JanRange = Sheet2020.Range(Cells(2, 1), Cells(2, 31))
Set FebRange = Sheet2020.Range(Cells(4, 1), Cells(4, 28))
Set MarRange = Sheet2020.Range(Cells(6, 1), Cells(6, 31))
Set AprRange = Sheet2020.Range(Cells(8, 1), Cells(8, 30))
Set MayRange = Sheet2020.Range(Cells(10, 1), Cells(10, 31))
Set JunRange = Sheet2020.Range(Cells(12, 1), Cells(12, 30))
Set JulRange = Sheet2020.Range(Cells(14, 1), Cells(14, 31))
Set AugRange = Sheet2020.Range(Cells(16, 1), Cells(16, 31))
Set SepRange = Sheet2020.Range(Cells(18, 1), Cells(18, 30))
Set OctRange = Sheet2020.Range(Cells(20, 1), Cells(20, 31))
Set NovRange = Sheet2020.Range(Cells(22, 1), Cells(22, 30))
Set DecRange = Sheet2020.Range(Cells(24, 1), Cells(24, 31))
Set DivRg = Application.Union(JanRange, FebRange, MarRange, AprRange, MayRange, JunRange, JulRange, AugRange, SepRange, OctRange, NovRange, DecRange)
Dim iSect As Range
Set iSect = Application.Intersect(Target, DivRg) 'Here, iSect gives me the value in the cell
'MsgBox "From Worksheet_SelectionChange" & iSect
If Not (iSect Is Nothing) And (iSect < 2#) Then
Application.EnableEvents = False
iSect = iSect * 60
If (iSect = 0) Then iSect = Empty
Application.EnableEvents = True
ElseIf Not (iSect Is Nothing) And (iSect = 2#) Then
'MsgBox "From Worksheet_SelectionChange, Please color code this cell"
iSect.Interior.Color = vbYellow
iSect.Font.Color = vbBlack
End If
Set DivRg = Nothing
End Sub
Как я могу изменить код для удовлетворения этому требованию несколько раз?