День добрый, подскажите как назначить переменной (ii) - что это время. При переносе с одного листа на другой, посредством макрос...нужно суммировать время и вывести как Итог: ДНИ, а не время.
Код |
---|
Sub Macro2() Dim i As Long, LastRow As Long, FreeRowStroy As Long, iCol As Long Dim ii As Long, CounterStroy As Long, CounterMont As Long, DR As String Dim FreeRowMont As Long, FreeRow1 As Long, Rng As Range, n As Long, RowStart As Long Application.ScreenUpdating = False LastRow = Cells(Rows.Count, 2).End(xlUp).Row Range(Cells(2, 1), Cells(LastRow + 1, 7)).Clear FreeRowStroy = 2 FreeRowMont = 2 FreeRow1 = 2 RowStart = 2 n = 3 With Sheets("ПУЛЛ") LastRow = .Cells(Rows.Count, 2).End(xlUp).Row For i = n To LastRow If .Cells(i, 1) <> "" Then DR = .Cells(i, 1) Cells(FreeRow1, 1) = .Cells(i, 1) End If For ii = i To LastRow If .Cells(ii, 1) = DR Or .Cells(ii, 1) = "" Then If .Cells(ii, 3) > 0 Then Set Rng = Sheets("справочник").Range("B2:C999").Find(what:=.Cells(ii, 2), LookIn:=xlValues, LookAt:=xlWhole) If Not Rng Is Nothing Then If Rng.Column = 2 Then Cells(FreeRowStroy, 2) = .Cells(ii, 2) Cells(FreeRowStroy, 4) = .Cells(ii, 3) CounterStroy = CounterStroy + 1 FreeRowStroy = FreeRowStroy + 1 Else Cells(FreeRowMont, 5) = .Cells(ii, 2) Cells(FreeRowMont, 7) = .Cells(ii, 3) CounterMont = CounterMont + 1 FreeRowMont = FreeRowMont + 1 End If End If End If Else i = ii - 1 If FreeRowStroy > FreeRowMont Then FreeRow1 = FreeRowStroy Else FreeRow1 = FreeRowMont End If Cells(FreeRow1, 2) = "Итого:" & DR Cells(FreeRow1, 3) = CounterStroy Cells(FreeRow1, 5) = "Итого:" & DR Cells(FreeRow1, 6) = CounterMont Cells(FreeRow1, 4) = Application.Text(ttime, "[hh]:mm") Cells(FreeRow1, 7) = Application.Text(ttime, "[hh]:mm") CounterStroy = 0 CounterMont = 0 With Range(Cells(RowStart, 1), Cells(FreeRow1, 1)) .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .BorderAround Weight:=xlThin End With Range(Cells(FreeRow1, 2), Cells(FreeRow1, 7)).Interior.ColorIndex = 15 Range(Cells(RowStart, 2), Cells(FreeRow1, 7)).Borders.LineStyle = True Cells(FreeRow1, 4) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 4), Cells(FreeRow1, 4))) / 24 Cells(FreeRow1, 7) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 7), Cells(FreeRow1, 7))) / 24 RowStart = FreeRow1 + 1 FreeRow1 = FreeRow1 + 1 FreeRowStroy = FreeRow1 FreeRowMont = FreeRow1 Exit For End If Next If ii > LastRow Then Cells(FreeRow1 + 25, 2) = "Итого:" & DR Cells(FreeRow1 + 25, 3) = CounterStroy Cells(FreeRow1 + 25, 5) = "Итого:" & DR Cells(FreeRow1 + 25, 6) = CounterMont Cells(FreeRow1 + 25, 4) = Application.Text(ttime, "[hh]:mm") Cells(FreeRow1 + 25, 7) = Application.Text(ttime, "[hh]:mm") With Range(Cells(RowStart, 1), Cells(FreeRow1 + 25, 1)) .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .BorderAround Weight:=xlThin End With Range(Cells(FreeRow1 + 25, 2), Cells(FreeRow1 + 25, 7)).Interior.ColorIndex = 17 Range(Cells(RowStart, 2), Cells(FreeRow1 + 25, 7)).Borders.LineStyle = True Cells(FreeRow1 + 25, 4) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 4), Cells(FreeRow1 + 5, 4))) / 24 Cells(FreeRow1 + 25, 7) = Application.WorksheetFunction.Sum(Range(Cells(RowStart, 7), Cells(FreeRow1 + 5, 7))) / 24 Exit Sub End If Next End With Application.ScreenUpdating = True End Sub |