多条记录汇总到一个单元格

xuxiaohua16888 · 发表于 2021-5-5 16:24

您好！在论坛看到您写的代码，能否也请你帮忙将表1的多条记录汇总到表2对应各班级的一个单元格中。感谢！

鄂龙蒙 · 发表于 2021-5-5 16:43

附件中“周”标志在哪呀

3190496160 · 发表于 2021-5-5 19:15

Sub huizong()
Dim d As Object
Dim ar As Variant
Dim br()
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 5)
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" Then
      t = d(Trim(ar(i, 2)))
      If t = "" Then
         k = k + 1
         d(Trim(ar(i, 2))) = k
         t = k
         br(k, 1) = k
         br(k, 2) = ar(i, 2)
      End If
      If br(t, 4) = "" Then
         br(t, 4) = ar(i, 3)
      Else
         br(t, 4) = br(t, 4) & "," & ar(i, 3)
      End If
      br(t, 5) = br(t, 5) + ar(i, 4)
End If
Next i
With Sheet2
.[a1].CurrentRegion.Offset(1) = Empty
.[a2].Resize(k, 5) = br
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2021-5-5 19:16

校务日誌(2021年春季)_ (数据).rar (170.74 KB, 下载次数: 10)

3190496160 · 发表于 2021-5-5 19:17

没有模拟数据，也不知道对不对，仅供参考

xuxiaohua16888 · 发表于 2021-5-6 16:24

鄂龙蒙发表于 2021-5-5 16:43
附件中“周”标志在哪呀

每周导出一次数据，然后汇总。手动写周次的。

xuxiaohua16888 · 发表于 2021-5-6 16:37

3190496160 发表于 2021-5-5 19:15
Sub huizong()
Dim d As Object
Dim ar As Variant

非常感谢！每次都要在表2运行代码吗？

xuxiaohua16888 · 发表于 2021-5-6 16:37

3190496160 发表于 2021-5-5 19:17
没有模拟数据，也不知道对不对，仅供参考

非常感谢！每次都要在表2运行代码吗？

		自动登录	找回密码
密码			免费注册

[求助] 多条记录汇总到一个单元格