vba根据部门分别汇总不同部门下的人员不同培训内容的时长总计,多条件求和

Option Explicit

Sub yy()
Dim d, arr, s$, i&, m&, w$
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.[a1].CurrentRegion.Value 'a1 数据 返回 a1 单元格周围的区域  ---直到  空行 空列
ReDim brr( To UBound(arr),  To ) '定义数组 brr为 4列 所有数据的最大行号
w = InputBox("请输入要汇总的部门：" & vbLf & "(不填部门 = 全部)", , "")
w = IIf(w = "", "*", w)
For i =  To UBound(arr)
   If arr(i, ) Like w Or arr(i, ) = "部门" Then '为条件帅选 部门
      s = arr(i, ) & arr(i, ) & arr(i, ) '为组合条件帅选  人名 内容 部门
      If Not d.exists(s) Then '字典 有 就  s（人名 内容 部门） 带有这三个的时长数值相加   没有就  写入s 与值
         m = m +
         d(s) = m
         brr(m, ) = arr(i, )
         brr(m, ) = arr(i, )
         brr(m, ) = arr(i, )
         brr(m, ) = arr(i, )
      Else
         brr(d(s), ) = brr(d(s), ) + arr(i, )

      End If
   End If
Next
Sheet2.[a1].CurrentRegion.Clear '清空第二张工作表a1 单元格周围的区域  ---直到  空行 空列
Sheet2.[a1].Resize(m, ) = brr ' 第二张工作表a1 单元格周围的区域  ---直到  空行 空列
'Resize调整指定区域的大小。返回 Range 对象，该对象代表调整后的区域。
'语法
'表达式.Resize(行数, 列数)
'表达式 一个返回 Range 对象的表达式。
Set d = Nothing '清空字典
End Sub

sheet1

sheet2

部门    人名    内容    时长
一部    张三    ABC    4.5
一部    张三    专业培训    3.5
一部    张三    部门英语培训
一部    李四    ABC    3.5
一部    李四    BCC    4.5
一部    李四    部门英语培训
一部    王五    ABC
一部    王五    专业培训    1.5
二部    王五    BCC    4.5
二部    王五    部门英语培训
二部    王五    专业培训
二部    王五    ABC
二部    赵六    一号工程
二部    赵六    ABC
二部    赵六    BCC
二部    赵六    专业培训
二部    赵六    外包工程    1.5
一部    孙七    ABC
三部    钱八    BCC
三部    钱八    CDD
三部    钱八    管理课程