帮忙修改代码求月数据的平均值

楚雪飘扬

帮忙修改代码求月数据的平均值
我现在计算出来的结果是将前面4周的数据在加上额外天数的数路，这样的结果是错的，
需要计算整个月底的数据I
If d = md(m) Then '如果是每个月的最后一天
            R = R + 1 'r（行数）递增1
            Cells(i + R, 1).EntireRow.Insert '在当前行下方插入一行
            Cells(i + R, 1) = m & "M" '在新插入的行的第一列写入"M月"
            For j = 2 To col - 1 '循环遍历每个月的数据列
                Cells(i + R, j) = av(j) + IIf(d <> 28, s(j), 0) / md(m) '计算最后一周的合计值
                 If j > 4 Then Cells(i + R, j) = (av(j) + IIf(d <> 28, s(j), 0))
            Next
            Cells(i + R, col) = Cells(i + R, col).Offset(0, -2) / Cells(i + R, col).Offset(0, -1)
            Range(Cells(i + R - (d - 1) Mod 7 - 1, 1), Cells(i + R - 1, 1)).EntireRow.Hidden = True
                   Range(Cells(i + R - (d - 1) Mod 7 - 1, 1), Cells(i + R - 1, 1)).EntireRow.Hidden = True

        End If
公司的电脑有限制没办法发附件

楚雪飘扬

Sub 明细周汇总()
    Application.ScreenUpdating = False '禁止屏幕刷新，加快代码执行速度
    Sheet1.Activate
    md = Array(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) '定义一个数组，存储每个月的天数
    Rows.EntireRow.Hidden = False '取消隐藏所有行
    a = [a1].CurrentRegion '将当前选定区域的数据赋值给变量a
    For i = UBound(a) To 2 Step -1 '从最后一行开始循环，逆序遍历
        If InStr(1, a(i, 1), "M", 1) <> 0 Then '如果第一列的单元格中包含"M"字符
            Range(i & ":" & i).Delete '删除该行
        End If
    Next
    a = [a1].CurrentRegion '更新变量a，排除了删除的行
    col = UBound(a, 2) '获取列数
    ReDim s(1 To col) '重新定义一个数组s，用于存储每列的累加值
    ReDim av(1 To col) '重新定义一个数组av，用于存储每列的平均值
    For i = 2 To UBound(a) '从第二行开始遍历---------------------------------------------------修改要开始计算的行
        d = Day(a(i, 1)): m = Month(a(i, 1)) '获取日期的天数和月份
        If d = 1 Then w = 0 '如果是每个月的第一天，w（周数）初始化为0
        For j = 2 To col - 1 '循环遍历每个月的数据列
            If d Mod 7 = 1 Then s(j) = 0 '如果是每周的第一天，s（累加值）初始化为0
            s(j) = s(j) + a(i, j) / 7 '累加每行的数据到s(j)
        Next
        s(26) = s(24) / s(25) '计算每周的平均值
        
        If d Mod 7 = 0 Then '如果是每周的最后一天
            R = R + 1: w = w + 1 'r（行数）递增1，w（周数）递增1
            Cells(i + R, 1).EntireRow.Insert '在当前行下方插入一行
            Cells(i + R, 1) = m & "M" & w & "W" '在新插入的行的第一列写入"M月W周"
            For j = 2 To col '循环遍历每个月的数据列
                If d = 7 Then av(j) = 0 '如果是每个月的第一周，av（平均值）初始化为0
                Cells(i + R, j) = s(j): av(j) = av(j) + s(j) / 7 '将累加值赋值给新插入行的对应列，更新合计值
            Next
            Range(Cells(i + R - 7, 1), Cells(i + R - IIf(i + md(m) - d <= UBound(a), 0, 1), 1)).EntireRow.Hidden = True '隐藏之前的一周数据行
'          Range(Cells(i + R - (d - 1) Mod 7 - 1, 1), Cells(i + R - 1, 1)).EntireRow.Hidden = True

        End If
        
        If d = md(m) Then '如果是每个月的最后一天
            R = R + 1 'r（行数）递增1
            Cells(i + R, 1).EntireRow.Insert '在当前行下方插入一行
            Cells(i + R, 1) = m & "M" '在新插入的行的第一列写入"M月"
            For j = 2 To col - 1 '循环遍历每个月的数据列
                Cells(i + R, j) = av(j) + IIf(d <> 28, s(j), 0) / md(m) '计算最后一周的合计值
                 If j > 4 Then Cells(i + R, j) = (av(j) + IIf(d <> 28, s(j), 0))
            Next
            Cells(i + R, col) = Cells(i + R, col).Offset(0, -2) / Cells(i + R, col).Offset(0, -1)
            Range(Cells(i + R - (d - 1) Mod 7 - 1, 1), Cells(i + R - 1, 1)).EntireRow.Hidden = True
                   Range(Cells(i + R - (d - 1) Mod 7 - 1, 1), Cells(i + R - 1, 1)).EntireRow.Hidden = True

        End If
    Next
    With Worksheets("明细") '将 "Sheet1" 替换为您要操作的工作表名称
        .Range("B:Y").NumberFormatLocal = "0_);[红色](0)"
    End With
    Application.ScreenUpdating = True
End Sub
以上是完整的代码

半百

没有附件估计只有神仙能帮忙了

楚雪飘扬

公司的电脑上传不了附件

楚雪飘扬

半百 发表于 2024-3-8 14:04
没有附件估计只有神仙能帮忙了

https://club.excelhome.net//forum.php?mod=viewthread&tid=1647795&extra=
这个有附件，可以帮忙看看吗

半百

试试这样看

下边一段也是