вычислить сумму чисел, исходя из даты и времени

[kartol]

Всем здравствуйте! Есть лист с данными . Подскажите как вычислить сумму чисел из одного столбца ,исходя из даты и перенести на новый лист с разбитием по дате и времени (с 0.00ч до 8.00ч; с 8.00-до 16.00ч; с 16.00 ч.до 24.00ч)

[agregator]

Например так

[kartol]

спасибо! но есть один нюанс - строк может быть N-ое количество(несколько тысяч)

[doober]

Попробуйте этот макрос.имена листов соответствуют примеру

Sub GO_Count()

Dim shet1, shet2, shet3, shet4
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim F, J
Set Sh1 = Worksheets("2погр")
Set Sh2 = Worksheets("выбор")
With Sh1
  F = .Range("F2:F" & .Range("$J$" & .Rows.Count).End(xlUp).Row)
  J = .Range("J2:J" & .Range("$J$" & .Rows.Count).End(xlUp).Row)
End With
shet4 = 1

Application.ScreenUpdating = False

Dim Y As Integer
Y = Day(J(1, 1))
For n = 1 To UBound(J)
     X = 3600 * Hour(J(n, 1)) + 60 * Minute(J(n, 1)) + Second(J(n, 1))
If Y <> Day(J(n, 1)) Then
With Sh2
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet3
    .Cells(shet4, 2) = Format(J(n, 1), "dd.mm.yyyy") & " 0.00-8.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet2
    .Cells(shet4, 2) = Format(J(n, 1), "dd.mm.yyyy") & " 8.00-16.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet1
    .Cells(shet4, 2) = Format(J(n, 1), "dd.mm.yyyy") & " 16.00-23.59.59"
End With
shet1 = 0: shet2 = 0: shet3 = 0
End If
   Y = Day(J(n, 1))
Select Case X
Case Is > 57599
       shet1 = shet1 + F(n, 1)
Case 28800 To 57599
       shet2 = shet2 + F(n, 1)
Case Is < 28800
       shet3 = shet3 + F(n, 1)
End Select
Next

Application.ScreenUpdating = True
End Sub

[agregator]

Вот, если будет 65536 строк

[kartol]

Спасибо всем. Doober такой вопрос по макросу _ при выборе- вместо 1декабря ставится дата 2 декабря,хотя считывает за 1 число. и так до конца на день вперёд

[doober]

Вот так будет правильно

Sub GO_Count()

Dim shet1, shet2, shet3, shet4
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim F, J
Set Sh1 = Worksheets("2погр")
Set Sh2 = Worksheets("выбор")

With Sh1
  F = .Range("F2:F" & .Range("$J$" & .Rows.Count).End(xlUp).Row)
  J = .Range("J2:J" & .Range("$J$" & .Rows.Count).End(xlUp).Row)
End With
shet4 = 1

Application.ScreenUpdating = False

Dim Y As Integer
Y = Day(J(1, 1))
For n = 1 To UBound(J)
     X = 3600 * Hour(J(n, 1)) + 60 * Minute(J(n, 1)) + Second(J(n, 1))
If Y <> Day(J(n, 1)) Then
With Sh2
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet3
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 0.00-8.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet2
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 8.00-16.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet1
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 16.00-23.59.59"
End With
shet1 = 0: shet2 = 0: shet3 = 0
End If
   Y = Day(J(n, 1))
Select Case X
Case Is > 57599
       shet1 = shet1 + F(n, 1)
Case 28800 To 57599
       shet2 = shet2 + F(n, 1)
Case Is < 28800
       shet3 = shet3 + F(n, 1)
End Select
Next
With Sh2
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet3
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 0.00-8.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet2
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 8.00-16.00"
shet4 = shet4 + 1
    .Cells(shet4, 1) = shet1
    .Cells(shet4, 2) = Format(J(n - 1, 1), "dd.mm.yyyy") & " 16.00-23.59.59"
End With
Application.ScreenUpdating = True
End Sub