汇总

ddz79101

老师！有同月不同日期的数据欲分类汇总。请老师帮忙看看。谢谢

清风竹-

请看附件。

3190496160

Sub 按月汇总()
Dim ar As Variant
Dim i As Long, r As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 3).End(xlUp).Row
    ar = .Range("c1:d" & r)
    ReDim br(1 To UBound(ar), 1 To 2)
    For i = 2 To UBound(ar)
        If ar(i, 1) <> "" Then
            If IsDate(ar(i, 1)) Then
                yf = Format(ar(i, 1), "yyyy/m")
                t = d(yf)
                If t = "" Then
                    k = k + 1
                    d(yf) = k
                    t = k
                    br(k, 1) = yf
                End If
                br(t, 2) = br(t, 2) + ar(i, 2)
            End If
        End If
    Next i
    rs = .Cells(Rows.Count, 9).End(xlUp).Row
    If rs > 1 Then .Range("i2:j" & rs) = Empty
    .[i2].Resize(k, 2) = br
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

字典的基础用法
按月汇总.rar (11.52 KB, 下载次数: 7)

2024-9-29 08:32 上传

点击文件名下载附件

ykcbf1100

参与一下，汇总用字典比较方便。

ykcbf1100

参与一下。。。

zhangcheng6688

学习一下字典
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   If arr(i, 3) <> "" Then
      rq = Mid(Format(arr(i, 3), "yyyy/mm/dd"), 1, 7)
      d(rq) = d(rq) + arr(i, 4)
   End If
Next
[i2].Resize(d.Count, 2) = Application.WorksheetFunction.Transpose(Array(d.keys, d.items))
End Sub

ddz79101

清风竹- 发表于 2024-9-29 08:28
请看附件。

谢谢老师！代码运行成功！

ddz79101

3190496160 发表于 2024-9-29 08:33
字典的基础用法

谢谢老师！代码运行成功！