Автоматическое добавление строки месяца-summery в конце каждого месяца?

Question

Я использую лист excel для отслеживания рабочего времени. Каждая строка представляет рабочий день и имеет «дату», «время в», «тайм-аут», «общее рабочее время» и «ежедневную зарплату». Я бы хотел, чтобы лист автоматически создавал месячную летнюю строку каждый раз, когда я пишу запись в следующем месяце (т. Е. Если строка с датой 13/3/16 сопровождается строкой с датой 2/4/16 , то вторая строка будет выталкиваться вниз, и ряд с Summery (то есть: общие ежемесячные часов, общая месячная зарплата) будет создана между оно должно выглядеть примерно так:.

это возможно, если? так, как я это делаю? Спасибо за ваш вклад!

Answer 1

Вы должны поместить этот код в лист модуля кода. Он работал для меня на данных, организованных как ваш.

Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim ThisSheet As Worksheet 
Dim NewRow As Long 
Dim OldTotalRange As Range 
Dim OldTotalRow As Long 

Set ThisSheet = ActiveSheet 
'If not single cell is changed, exit sub 
If Target.Cells.Count = 1 Then 
'Disable events for prevent recursion 
Application.EnableEvents = False 
If Target.Column = 1 And Target.Row <> 1 And Target.value <> "" Then 
    If IsDate(Target.value) And IsDate(Target.Offset(-1, 0).value) Then 
     If Month(Target.value) <> Month(Target.Offset(-1, 0).value) Then 
      With ThisSheet 
       NewRow = Target.Row 
       On Error Resume Next 
        Set OldTotalRange = .Columns(1).Find(What:="Total", After:=Target, SearchDirection:=xlPrevious) 
        OldTotalRow = OldTotalRange.Row 
'It's for first 'Total' when there isn't 'totals' before. 
       If OldTotalRow = 0 Then 
        OldTotalRow = 1 
       End If 
        .Rows(NewRow).Insert 
        .Cells(NewRow, 1) = "Total" 
        .Cells(NewRow, 4).FormulaR1C1 = "=SUM(R[-" & NewRow - OldTotalRow - 1 & "]C:R[-1]C)" 
        .Cells(NewRow, 5).FormulaR1C1 = "=SUM(R[-" & NewRow - OldTotalRow - 1 & "]C:R[-1]C)" 
'It's formatting, you can delete it or change 
        .Range(.Cells(NewRow, 1), .Cells(NewRow, 5)).Interior.Color = RGB(196, 215, 155) 
        .Range(.Cells(NewRow, 1), .Cells(NewRow, 5)).Font.Bold = True 
      End With 
     End If 
    End If 
End If 
Else 
Exit Sub 
End If 
'Enable events 
Application.EnableEvents = True 
End Sub