贴吧提问《求助 按周期在日期数据里提取最大值最小值,以及周一周天的数据》,使用字典嵌套数组可以很方便的获取数据
注意:对于字典嵌套的数组,不可以像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