求助-按多条件汇总求和数据

wcj6376tcp

麻烦群里的大神帮忙搞一下代码：

表里数据很多这里只是其中一部分   需求：1，按条件 预算项目 把相同收款人的数据筛选到该工作薄后面以收款人命名的工作表里面 并汇总实际支付总金额。

2，如收款人相同但使用的资金预算项目不同需要分开统计在同一个工作表。

另外随着每次导出时间不同，数据工作表的名称后部分会自动变化，希望可以通用。

谢谢！

limonet

第2与第1好像有点互斥，要么关键字给个引号，要么按哪列拆，你提炼下。

ykcbf1100

请楼主摸拟一个结果表上传，现在不知道新增的表的结构如何

wcj6376tcp

limonet 发表于 2024-5-18 19:24
第2与第1好像有点互斥，要么关键字给个引号，要么按哪列拆，你提炼下。

按预算项目代码拆分主要是我标色的几列，收款人相同就筛选到一个表里去

wcj6376tcp

ykcbf1100 发表于 2024-5-18 19:27
请楼主摸拟一个结果表上传，现在不知道新增的表的结构如何

与数据表结构保持一致就行。方便以后年末提取各类资金使用情况。

limonet

ykcbf1100 发表于 2024-5-18 19:27
请楼主摸拟一个结果表上传，现在不知道新增的表的结构如何

你来吧，我就算了。

Qs18

Public Sub test()
Application.ScreenUpdating = False
Dim dic As Object, arr, i, sht As Worksheet
arr = Sheet1.UsedRange
Set dic = CreateObject("scripting.dictionary")
For i = 4 To UBound(arr)
    If Not dic.exists(arr(i, 25)) Then
        dic(arr(i, 25)) = arr(i, 9)
   
    Else
        dic(arr(i, 25)) = dic(arr(i, 25)) + arr(i, 9)
    End If
Next
For Each k In dic.keys
    Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
    sht.Name = k
    sht.Range("a1").Value = arr(2, 25)
    sht.Range("b1").Value = arr(2, 9)
    sht.Range("a2").Value = k
    sht.Range("b2").Value = dic(k)
Next
Sheet1.Activate
Set dic = Nothing
Application.ScreenUpdating = True
End Sub

ykcbf1100

limonet 发表于 2024-5-18 19:35
你来吧，我就算了。

你谦虚了吧。

ykcbf1100

wcj6376tcp 发表于 2024-5-18 19:32
与数据表结构保持一致就行。方便以后年末提取各类资金使用情况。

与原表结构相同不太好处理，因为支付申请号、支付凭证号、申请日期，这些无法合并的。感觉你自己也没有想好。我还是先看看再定吧。如果只是按收款人把数据拆分出来不汇总，那应该还是没有问题的。

limonet

ykcbf1100 发表于 2024-5-18 19:46
你谦虚了吧。

最主要是怕猜错。