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

三部    钱八    管理课程