Здравствуйте! Есть выгрузка запросов за месяц, как реализовать макрос, подсчитывающий среднее количество поступивших запросов в час, т.е. интенсивность их поступления в 8 часов ( с 8:00 до 9:00), в 9 часов (с 9:00 до 10:00) в 10, 11...17 и за весь месяц. Подскажите пожалуйста, как такое можно реализовать в VBA, чтобы по нажатию кнопки выводилась в отдельном листе табличка с этими данными ?
Здравствуйте! Есть выгрузка запросов за месяц, как реализовать макрос, подсчитывающий среднее количество поступивших запросов в час, т.е. интенсивность их поступления в 8 часов ( с 8:00 до 9:00), в 9 часов (с 9:00 до 10:00) в 10, 11...17 и за весь месяц. Подскажите пожалуйста, как такое можно реализовать в VBA, чтобы по нажатию кнопки выводилась в отдельном листе табличка с этими данными ? darith
Sub ertert() Dim x, y(), i&, j&, hr&, cnt& Dim dt As Date, cl& With Sheets("BD") x = .Range("B1:D" & .Cells(Rows.Count, 2).End(xlUp).Row).Value End With ReDim y(1 To 2, 1 To 11)
With CreateObject("Scripting.Dictionary") ' .CompareMode = 1 For i = 2 To UBound(x) If x(i, 1) <> dt Then cnt = cnt + 1: dt = x(i, 1) hr = Hour(x(i, 3)) If .exists(hr) Then cl = .Item(hr) y(2, cl) = y(2, cl) + 1 Else j = j + 1: .Item(hr) = j y(1, j) = hr: y(2, j) = 1 End If Next i End With For j = 1 To UBound(y, 2) y(2, j) = y(2, j) / cnt Next j
With Sheets("Input") .Range("D2").CurrentRegion.Offset(1).ClearContents With Range("D2").Resize(UBound(y), UBound(y, 2)) .Value = y() .Sort Key1:=.Cells(1), Order1:=xlAscending, Orientation:=xlLeftToRight End With End With End Sub
[/vba]
darith, привет попробуйте реализовать так:
[vba]
Код
Sub ertert() Dim x, y(), i&, j&, hr&, cnt& Dim dt As Date, cl& With Sheets("BD") x = .Range("B1:D" & .Cells(Rows.Count, 2).End(xlUp).Row).Value End With ReDim y(1 To 2, 1 To 11)
With CreateObject("Scripting.Dictionary") ' .CompareMode = 1 For i = 2 To UBound(x) If x(i, 1) <> dt Then cnt = cnt + 1: dt = x(i, 1) hr = Hour(x(i, 3)) If .exists(hr) Then cl = .Item(hr) y(2, cl) = y(2, cl) + 1 Else j = j + 1: .Item(hr) = j y(1, j) = hr: y(2, j) = 1 End If Next i End With For j = 1 To UBound(y, 2) y(2, j) = y(2, j) / cnt Next j
With Sheets("Input") .Range("D2").CurrentRegion.Offset(1).ClearContents With Range("D2").Resize(UBound(y), UBound(y, 2)) .Value = y() .Sort Key1:=.Cells(1), Order1:=xlAscending, Orientation:=xlLeftToRight End With End With End Sub