Код ниже позволит вам ввести общее количество часов для каждого дня. Это добавит число, которое вы вводите к предыдущему итогу, и заменит вашу запись на сумму. Вы можете ввести ноль, в результате чего будет получен новый итог, который не изменился по сравнению с предыдущим. После ввода код перейдет к следующему листу, выбрав ячейку для заполнения на день и выделив зеленую дату. Если запись уже есть, выделение будет розовым.
Если в предыдущие дни не было записей, предполагается, что часы не отработаны, и запись завершена соответственно над строкой, в которую вы вводите текущие часы. Нельзя вводить отрицательные числа часов или часов в превышение 24. Вы не можете вводить в ячейки, где есть записи ниже ячейки, которую вы хотите изменить, даже если эта ячейка пуста.
Код состоит из двух компонентов. Первый взнос должен go в стандартный модуль кода. Это тот, который не существует в вашей книге. Найдите способ добавить модуль. Если его имя похоже на Module1, это правильно. Вставьте код ниже в него. Я бы предпочел переименовать модуль (возможно, как «STO_200408»), но в этом нет необходимости.
Option Explicit
Enum Nws ' worksheet navigation
' Variatus @STO 08 Apr 2020
NwsFirstDataRow = 2 ' modify if your data don't start in row 2
NwsDate = 1 ' date column: 1 identifies column A
NwsHours = 3
End Enum
Sub WorksheetActivate(Ws As Worksheet)
' Variatus @STO 08 Apr 2020
Dim Rng As Range
Set Rng = Ws.Columns(NwsDate).Find(Date, , , xlWhole)
If Rng Is Nothing Then
MsgBox "I didn't find today's date on the """ & _
Ws.Name & """." & vbCr & _
"It may have been entered using an invalid format.", _
vbInformation, "Missing or invalid date"
Else
WorksheetDeactivate Ws ' remove existing highlight
With Rng.Resize(1, NwsHours)
.Interior.Color = IIf(.Cells(NwsHours).Value, 13431551, 14348258)
.Cells(NwsHours).Select
End With
End If
End Sub
Function WorksheetChange(Target As Range) As Boolean
' Variatus @STO 08 Apr 2020
' return Not True if accumulator couldn't be set
Dim Rng As Range
Dim Hours As Double
Dim Accu As Double
Dim R As Long
With Target
If .Cells.CountLarge > 1 Then Exit Function
With .Worksheet
R = .Cells(.Rows.Count, NwsDate).End(xlUp).Row
Set Rng = .Range(.Cells(NwsFirstDataRow, NwsHours), _
.Cells(R, NwsHours))
End With
If Not Application.Intersect(Target, Rng) Is Nothing Then
Application.EnableEvents = False
If GetAccu(Accu, Target.Worksheet, .Row) Then
Hours = Val(.Value)
' modify if you record time hours:-
If (Hours > 24) Or (Hours < 0) Then
MsgBox "Please enter a positive value smaller or equal to 24 hours.", _
vbExclamation, "Invalid number of hours"
GoTo SideExit
End If
.Value = Accu + Val(.Value)
WorksheetChange = True
Else
SideExit:
.Select
End If
Application.EnableEvents = True
End If
End With
End Function
Sub WorksheetDeactivate(Ws As Worksheet)
' Variatus @STO 08 Apr 2020
Dim Rng As Range
With Ws
Set Rng = .Range(.Cells(NwsFirstDataRow, NwsDate), _
.Cells(.Rows.Count, NwsDate).End(xlUp) _
.Offset(0, NwsHours - 1))
Rng.Interior.Pattern = xlNone
End With
End Sub
Private Function GetAccu(Accu As Double, _
Ws As Worksheet, _
ByVal Rt As Long) As Boolean
' Variatus @STO 08 Apr 2020
' 'Accu' is a return variable
' return Not True if no b/f total could be determined
Dim R As Long
With Ws
If .Cells(.Rows.Count, NwsHours).End(xlUp).Row > Rt Then
MsgBox "There may be no entries in the 'Hours' column" & vbCr & _
"below the entry now being processed." & vbCr & _
"Remove existing entries and repeat.", _
vbExclamation, "Record irregularity"
Else
GetAccu = True
With .Cells(NwsFirstDataRow, NwsHours)
If Len(.Value) = 0 Then .Value = 0
End With
R = Rt
Do
R = R - 1
With .Cells(R, NwsHours)
If Len(.Value) Then
Accu = Val(.Value)
Exit Do
End If
End With
Loop While R > NwsFirstDataRow
For R = (R + 1) To (Rt - 1)
.Cells(R, NwsHours).Value = Accu
Next R
End If
End With
End Function
Sub GotoNextSheet()
' Variatus @STO 08 Apr 2020
Dim Idx As Integer
Idx = ActiveSheet.Index + 1
If Idx > Worksheets.Count Then Idx = 1
Worksheets(Idx).Activate
End Sub
Далее найдите модуль кода, принадлежащий листу, на котором вы храните часы для машины. Если дважды щелкнуть имя рабочего листа в проводнике проектов VB Editor, откроется правильный лист кода. Вставьте код, который вы найдете ниже, в этот лист.
Option Explicit
Private Sub Worksheet_Activate()
' Variatus @STO 08 Apr 2020
WorksheetActivate ActiveSheet
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Variatus @STO 08 Apr 2020
If WorksheetChange(Target) Then GotoNextSheet
End Sub
Private Sub Worksheet_Deactivate()
' Variatus @STO 08 Apr 2020
WorksheetDeactivate ActiveSheet
End Sub
Этот код связывает то, что происходит на этом листе, с кодом в Module1. Теперь вы можете сделать записи в столбце C этого листа и увидеть действие. Я предлагаю вам сделать это, чтобы проверить и код, и его местоположение.
Поскольку вы хотите выполнить действие на всех своих 80 листах, один и тот же код должен быть вставлен в лист кодов для всех 80. Обратите внимание, что код будет скопирован в копию листа, если вы создаете его, используя правую кнопку мыши на вкладке, но не если вы выбираете весь лист и вставляете его на новый лист. Таким образом, чтобы начать новый месяц, вы можете создавать копии из шаблона, который включает в себя код, и вам не придется беспокоиться о копировании кода отдельно.
Как только все ваши 80 листов будут иметь код события, для которого вы установили go. Обратите внимание, что код будет переходить к следующему листу после каждой записи, а l oop - к первому при попадании в последний. Вы узнаете, когда закончите, когда увидите, что цвет выделения изменился на розовый, а выбранная ячейка уже содержит сумму.