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

xuxiaohua16888

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

鄂龙蒙

附件中“周”标志在哪呀

3190496160

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年春季)_ (数据).rar (170.74 KB, 下载次数: 10)

2021-5-5 19:16 上传

点击文件名下载附件

3190496160

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

xuxiaohua16888

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

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

xuxiaohua16888

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

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

xuxiaohua16888

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

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