帮忙月汇总数据结果

楚雪飘扬

请各位老师帮忙修改下代码

在汇总月数据的时候，计算结果出错（得出的结果为平均值）
需要的结果为需要为汇总结果，正确结果详见下面

liulang0808

楼主的代码加密了。。。

楚雪飘扬

liulang0808 发表于 2022-11-29 17:19
楼主的代码加密了。。。

不好意思，忘记取消密码了，

现密码已取消，请老师帮忙抽空看看

gwjkkkkk

Sub 按钮361_Click()
Dim arr, i&, j&
With [A1].CurrentRegion
  arr = Union(.Offset(), .Offset(1))
End With
For i = 2 To UBound(arr) - 1
   If InStr(arr(i, 1), "1M") Then
      For j = 2 To UBound(arr, 2)
          arr(UBound(arr), j) = arr(UBound(arr), j) + arr(i, j)
      Next j
   End If
Next i
arr(UBound(arr), 1) = "1M"
[A1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

gwjkkkkk

不知道是不是这个意思，请楼主参考。。。

楚雪飘扬

gwjkkkkk 发表于 2022-11-29 18:28
不知道是不是这个意思，请楼主参考。。。

老师您好，这是我最终的结果，每个月从1号到7号（7天）为一个周期
根据日期先汇总周的数据 ，然后在根据周的数据，汇总成月

zxsea_7426

原代码修改如下：

Sub 明细周汇总()
Application.ScreenUpdating = False
   md = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
   Rows.EntireRow.Hidden = False
   a = [a1].CurrentRegion
   For i = UBound(a) To 2 Step -1
      If InStr(1, a(i, 1), "M", 1) <> 0 Then 'If Mid(a(i, 1), 2, 1) = "M" Then
         Range(i & ":" & i).Delete
      End If
   Next
   a = [a1].CurrentRegion
   col = UBound(a, 2)
   ReDim s(1 To col)
   ReDim av(1 To col)
   For i = 2 To UBound(a)
      d = Day(a(i, 1)): m = Month(a(i, 1))
      If d = 1 Then w = 0
      For j = 2 To col - 1
'      For j = 2 To col
         If d Mod 7 = 1 Then s(j) = 0
         s(j) = s(j) + a(i, j)
      Next
'      s(col) = a(i, col)
      s(9) = s(7) / s(8)
      If d Mod 7 = 0 Then
         r = r + 1: w = 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
            Cells(i + r, j) = s(j): av(j) = av(j) + s(j)
         Next
         Range(Cells(i + r - 7, 1), Cells(i + r - IIf(i + md(m) - d <= UBound(a), 0, 1), 1)).EntireRow.Hidden = True
      End If

      If d = md(m) Then
         r = r + 1
         Cells(i + r, 1).EntireRow.Insert
         Cells(i + r, 1) = m & "M"
         For j = 2 To col - 1
            Cells(i + r, j) = (av(j) + IIf(d <> 28, s(j), 0)) '/ (w + d Mod 7)
         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
      End If
   Next
   Application.ScreenUpdating = True
End Sub

zxsea_7426

.......................

楚雪飘扬

zxsea_7426 发表于 2022-11-29 19:59
.......................

改了好久，都没改成功

zxsea_7426

楚雪飘扬 发表于 2022-11-29 20:04
改了好久，都没改成功

重写的代码我撤了，原代码基础上修改的正在审核
先上个图