|
Sub ss()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Range("a1").CurrentRegion.Value
For i = 2 To UBound(arr)
rq = DateValue(arr(i, 2))
rq1 = DateValue(arr(i, 3))
If rq <> rq1 Then GoTo aa
st = TimeValue(arr(i, 2))
et = TimeValue(arr(i, 3))
If st >= TimeValue("19:00:00") And et <= TimeValue("22:00:00") Then
d(rq) = d(rq) + arr(i, 4)
End If
aa:
Next
Range("F2").Resize(d.Count, 2).ClearContents
Range("F2").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
Range("G2").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.items)
End Sub
|
|