求用数组字典对数据进行分类汇总，日期分列求和，提提意见，谢谢！

月下当前

对源数据日期三个项目下费用项目分成4个列项目展开存在的日期求和，项目1里面分成2个项目，项目2还是原来的项目，项目3里面仅对运营费用以及损耗合计求和，其他项目忽略不计，如效果图2所示，请大家帮帮忙，或者提示下，谢谢了。

gwjkkkkk

请楼主参考，建议说明在文件中进行了说明。。。

shiruiqiang

字典，for 列的时候step2

3190496160

Sub 分类求和()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("数据源")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "数据源为空！": End
    ar = .Range("a1:g" & r)
End With
With Sheets("效果")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs > 1 Then .Range("a2:e" & rs).Borders.LineStyle = 0: .Range("a2:e" & rs) = Empty
    rr = Split(.[e1], "+")
    h = UBound(ar)
    br = .Range("a1:e" & h)
    For j = 2 To UBound(br, 2) - 1
        If Trim(br(1, j)) <> "" Then
            d(Trim(br(1, j))) = j
        End If
    Next j
    k = 1
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If IsDate(ar(i, 1)) Then
                t = d(ar(i, 1))
                If t = "" Then
                    k = k + 1
                    d(ar(i, 1)) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                End If
                For j = 2 To 6 Step 2
                    If Trim(ar(i, j)) <> "" Then
                        If j < 6 Then
                            lh = d(Trim(ar(i, j)))
                            If lh <> "" Then
                                br(t, lh) = br(t, lh) + ar(i, j + 1)
                            End If
                        ElseIf j = 6 Then
                            If Trim(ar(i, j)) = Trim(rr(0)) Or Trim(ar(i, j)) = Trim(rr(1)) Then
                                br(t, 5) = br(t, 5) + ar(i, j + 1)
                            End If
                        End If
                    End If
                Next j
            End If
        End If
    Next i
    .[a1].Resize(k, UBound(br, 2)) = br
    .[a1].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

测试字典数组.rar (15.21 KB, 下载次数: 13)

2022-11-30 10:57 上传

点击文件名下载附件

3190496160

注意这里的变化

月下当前

gwjkkkkk 发表于 2022-11-29 23:18
请楼主参考，建议说明在文件中进行了说明。。。

好的，谢谢了

月下当前

3190496160 发表于 2022-11-30 11:00
注意这里的变化

明白，谢谢了

月下当前

shiruiqiang 发表于 2022-11-29 23:47
字典，for 列的时候step2

好的，我会学习学习

3190496160

月下当前 发表于 2022-11-30 11:09
明白，谢谢了

18年就注册的老会员了，还在问这种低级的问题，说明，这些年只是一味地伸手吧，