vba 汇总然后变成横向排列

kifun · 发表于 2023-12-27 23:07

本帖最后由 kifun 于 2023-12-28 12:36 编辑

大家好，可以帮忙写一下吗？

需求：
1.类别不确定有N个，工作量不确定N个。
2.根据类别先去重汇总。
3.再得到右边的表格形式。
本来以为很简单，自己写了之后发现没思路，不知道怎么写。
微信图片_20231227230427.png

20231228-122639.zip (2.68 KB, 下载次数: 21)

liulang0808 · 发表于 2023-12-28 07:59

建议楼主上传模拟附件，并结合附件内容描述具体需求

3190496160 · 发表于 2023-12-28 08:49

求助务必上传excel附件侧可能得到别人的帮助，
你的问题，就是一个数组+字典的问题，但是，没有附件是没有办法写代码的

LIUZHU · 发表于 2023-12-28 11:14

是这样的效果吧？

kifun · 发表于 2023-12-28 12:37

liulang0808 发表于 2023-12-28 07:59
建议楼主上传模拟附件，并结合附件内容描述具体需求

好的，已上传附件，希望可以得到您的帮助，谢谢。

kifun · 发表于 2023-12-28 12:38

LIUZHU 发表于 2023-12-28 11:14
是这样的效果吧？

是的，就是这个效果，忘了说，类别和工作量不确定，有N个。可以把文件发我看看嘛？

kifun · 发表于 2023-12-28 12:39

3190496160 发表于 2023-12-28 08:49
求助务必上传excel附件侧可能得到别人的帮助，
你的问题，就是一个数组+字典的问题，但是，没有附件是没有 ...

好的，已上传附件，希望可以得到您的帮助，谢谢。

liulang0808 · 发表于 2023-12-28 13:07

Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Set dnm = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To UBound(arr) * UBound(arr, 2))
r = 2
c = 1
For j = 2 To UBound(arr)
      If Not dnm.exists(arr(j, 1)) Then
         r = r + 1
         dnm(arr(j, 1)) = r
         brr(r, 1) = arr(j, 1)
      End If
      rx = dnm(arr(j, 1))
      If Not d.exists(arr(j, 2)) Then
         Set d(arr(j, 2)) = CreateObject("scripting.dictionary")
         For i = 3 To UBound(arr, 2)
            c = c + 1
            brr(1, c) = arr(j, 2)
            brr(2, c) = arr(1, i)
            d(arr(j, 2))(arr(1, i)) = c
            brr(rx, c) = arr(j, i)
         Next i
      Else
         For i = 3 To UBound(arr, 2)
            brr(rx, d(arr(j, 2))(arr(1, i))) = Val(brr(rx, d(arr(j, 2))(arr(1, i)))) + Val(arr(j, i))
         Next i
      End If

Next j
[h10].Resize(r, c) = brr
End Sub

liulang0808 · 发表于 2023-12-28 13:07

20231228-122639.zip (17.46 KB, 下载次数: 35)
做了一个简单转换，格式上，楼主可以自己再处理的

沈默00 · 发表于 2023-12-28 13:39

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

[求助] vba 汇总然后变成横向排列

评分