VBA宏按团队分组和报告平均值

时间:2017-03-01 17:57:19

标签: excel-vba vba excel

我需要运行每周一次的报告,我会获得与不同团队相关联的用户列表以及每个给定任务的完成时间。我需要报告每个团队完成任务的平均周期时间。

task    Name    Team    Cycle time
7701    john    A            5
7825    tom     A            2
6945    terri   C            7
7036    jane    B            6
6946    tim     B            9
6899    john    A            4
7135    jim     C            6
7805    jim     C            2
9405    terri   C            8
6209    jason   B            2
7508    derek   A            4
8305    derek   A            5
8426    jane    B            6
3256    juan    C            7

任务,人员和团队的数量将是动态的

我的想法是以某种方式将团队数据拆开,然后从那里获得平均周期时间,但我不确定如何实现这一点。有没有人知道用于取消堆栈数据的VBA命令?

感谢您提出的任何想法。

1 个答案:

答案 0 :(得分:0)

Sub macro1()
Dim lastRow As Long, lastRow2 As Long, myArray() As Variant, longNum As Long
Dim total As Long, rowNumb As Long, tallyCount As Long

'**************************************************************************
'   This macro uses arrays because it is quicker than ranges
'   However it does paste an array to an out of the way place at columns(zw to zz)
'   I did this to incorporate a speedy removeduplicates so we would have
'   a single list of names

'   Then it siphons through the arrays to get totals for each member and
'   their averages.
'
'   It assumes your data is in columns a through d and puts
'   Memebr Name in Column E
'   Member total in column F
'   Member Average in column G

lastRow = Range("A65536").End(xlUp).Row
myArray = Range("A1:D" & lastRow)
Range("ZW1:ZZ" & lastRow) = myArray
Columns(Range("ZX" & 1).Column).Select
Range("ZX1:ZX" & lastRow).RemoveDuplicates Columns:=Array(1), Header:=xlYes
lastRow2 = Range("ZX65536").End(xlUp).Row
nameArray = Range("ZX2:ZX" & lastRow2)
Range("ZW1:ZZ" & lastRow).ClearContents
Range("A1").Select
rowNumb = 2
For i = LBound(nameArray) To UBound(nameArray)
    Debug.Print nameArray(i, 1)
Next i

For i = LBound(nameArray) To UBound(nameArray)
    total = 0
    For j = LBound(myArray) To UBound(myArray)
        If myArray(j, 2) = nameArray(i, 1) Then
            tallyCount = tallyCount + 1
            total = total + myArray(j, 4)
        End If
    Next j
        If total <> 0 Then
            Range("E" & rowNumb) = nameArray(i, 1)
            Range("F" & rowNumb) = total
            Range("G" & rowNumb) = total / tallyCount
            rowNumb = rowNumb + 1
            tallyCount = 0
        End If
Next i
End Sub