Excel·VBA按日期汇总数据

贴吧提问《求助 按周期在日期数据里提取最大值最小值，以及周一周天的数据》，使用字典嵌套数组可以很方便的获取数据

注意：对于字典嵌套的数组，不可以像python一样直接对数组元素进行赋值修改，而应该对整个数组重新赋值

如第12行代码如果是 If Weekday(rq) = 2 Then dict(nz)(2) = sj 则会报错

Sub 按日期汇总数据()
    '字典嵌套数组，键为“**年**周”，值为Array(最大值, 最小值, 周一值, 周五值)
    Dim arr, i, rq, nz, sj, k, v, x, dict As Object
    Set dict = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr):
        rq = arr(i, 1)  '日期
        nz = Year(rq) & "年" & WorksheetFunction.WeekNum(rq) & "周"  '年-周，key
        sj = arr(i, 2)  '数据
        If Not dict.Exists(nz) Then  '新键-值
            dict(nz) = Array(sj, sj, "", "")
            If Weekday(rq) = 2 Then dict(nz) = Array(dict(nz)(0), dict(nz)(1), sj, dict(nz)(3))  '周一值
            If Weekday(rq) = 6 Then dict(nz) = Array(dict(nz)(0), dict(nz)(1), dict(nz)(2), sj)  '周五值
        Else  '已有键-值，更新
            If sj > dict(nz)(0) Then dict(nz) = Array(sj, dict(nz)(1), dict(nz)(2), dict(nz)(3))  '最大值
            If sj < dict(nz)(1) Then dict(nz) = Array(dict(nz)(0), sj, dict(nz)(2), dict(nz)(3))  '最小值
            If Weekday(rq) = 2 Then dict(nz) = Array(dict(nz)(0), dict(nz)(1), sj, dict(nz)(3))  '周一值
            If Weekday(rq) = 6 Then dict(nz) = Array(dict(nz)(0), dict(nz)(1), dict(nz)(2), sj)  '周五值
        End If
    Next
    
    k = dict.keys
    v = dict.Items
    For x = 0 To dict.count - 1:  '遍历字典
        row_write = [f1].CurrentRegion.Rows.count + 1  '输出结果区域的第一个空行写入
        Cells(row_write, 6).Resize(1, 1) = k(x)
        Cells(row_write, 7).Resize(1, 4) = v(x)
    Next
    
End Sub

举例：

按日期汇总数据-举例