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(1 To UBound(arr), 1 To 4) '定义数组 brr为 4列 所有数据的最大行号
w = InputBox("请输入要汇总的部门：" & vbLf & "(不填部门 = 全部)", , "")
w = IIf(w = "", "*", w)
For i = 1 To UBound(arr)
   If arr(i, 5) Like w Or arr(i, 5) = "部门" Then '为条件帅选 部门
      s = arr(i, 1) & arr(i, 3) & arr(i, 5) '为组合条件帅选  人名 内容 部门
      If Not d.exists(s) Then '字典 有 就  s（人名 内容 部门） 带有这三个的时长数值相加   没有就  写入s 与值
         m = m + 1
         d(s) = m
         brr(m, 1) = arr(i, 5)
         brr(m, 2) = arr(i, 1)
         brr(m, 3) = arr(i, 3)
         brr(m, 4) = arr(i, 4)
      Else
         brr(d(s), 4) = brr(d(s), 4) + arr(i, 4)
         
      End If
   End If
Next
Sheet2.[a1].CurrentRegion.Clear '清空第二张工作表a1 单元格周围的区域  ---直到  空行 空列
Sheet2.[a1].Resize(m, 4) = brr ' 第二张工作表a1 单元格周围的区域  ---直到  空行 空列
'Resize调整指定区域的大小。返回 Range 对象，该对象代表调整后的区域。
'语法
'表达式.Resize(行数, 列数)
'表达式 一个返回 Range 对象的表达式。
Set d = Nothing '清空字典
End Sub

sheet1

sheet2

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