Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 76|回复: 7

[已解决]周汇总代码修改

[复制链接]
发表于 2021-11-25 16:48 | 显示全部楼层 |阅读模式
请各位帮忙修改下周汇总代码,现在使用的代码是每7天汇总成一周,数据是求的平均值现在的需求需要将平均值采用求合(累加)的形式进行汇总并算出达成率!
Sub demo()
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
         If d Mod 7 = 1 Then s(j) = 0
         s(j) = s(j) + a(i, j)
      Next
      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"
         For j = 2 To col
            If d = 7 Then av(j) = 0
            Cells(i + r, j) = s(j) / 7: 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
      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
            Cells(i + r, j) = (av(j) + IIf(d <> 28, s(j), 0)) / (w + d Mod 7)
         Next
         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

最佳答案
2021-11-25 19:23
  1. Sub demo()
  2. Application.ScreenUpdating = False
  3.    md = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
  4.    Rows.EntireRow.Hidden = False
  5.    a = [a1].CurrentRegion
  6.    For i = UBound(a) To 2 Step -1
  7.       If InStr(1, a(i, 1), "M", 1) <> 0 Then 'If Mid(a(i, 1), 2, 1) = "M" Then
  8.          Range(i & ":" & i).Delete
  9.       End If
  10.    Next
  11.    n = 1
  12.    a = [a1].CurrentRegion
  13.    col = UBound(a, 2)
  14.    ReDim s(1 To col)
  15.    ReDim av(1 To col)
  16.    For i = 2 To UBound(a)
  17.       d = Day(a(i, 1)): m = Month(a(i, 1))
  18.       If d = 1 Then w = 0
  19.       For j = 2 To col
  20.          If d Mod 7 = 1 Then s(j) = 0
  21.          s(j) = s(j) + a(i, j)
  22.       Next
  23.       If d Mod 7 = 0 Then
  24.          r = r + 1: w = w + 1
  25.          Cells(i + r, 1).EntireRow.Insert
  26.          Cells(i + r, 1) = m & "M" & w & "W"
  27.          For j = 2 To col - 1
  28.             If j = col Then n = 7
  29.             If d = 7 Then av(j) = 0
  30.             Cells(i + r, j) = s(j) / n
  31.          Next
  32.          Cells(i + r, j) = Cells(i + r, j - 1) / Cells(i + r, j - 2)
  33.          Range(Cells(i + r - 7, 1), Cells(i + r - IIf(i + md(m) - d <= UBound(a), 0, 1), 1)).EntireRow.Hidden = True
  34.       End If

  35.       If d = md(m) Then
  36.          r = r + 1
  37.          Cells(i + r, 1).EntireRow.Insert
  38.          Cells(i + r, 1) = m & "M"
  39.          For j = 2 To col
  40.             Cells(i + r, j) = (av(j) + IIf(d <> 28, s(j), 0)) / (w + d Mod 7)
  41.          Next
  42.          Range(Cells(i + r - (d - 1) Mod 7 - 1, 1), Cells(i + r - 1, 1)).EntireRow.Hidden = True
  43.       End If
  44.    Next
  45.    Application.ScreenUpdating = True
  46. End Sub
复制代码

累加周汇总.rar

18.1 KB, 下载次数: 4

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-11-25 19:23 | 显示全部楼层    本楼为最佳答案   
  1. Sub demo()
  2. Application.ScreenUpdating = False
  3.    md = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
  4.    Rows.EntireRow.Hidden = False
  5.    a = [a1].CurrentRegion
  6.    For i = UBound(a) To 2 Step -1
  7.       If InStr(1, a(i, 1), "M", 1) <> 0 Then 'If Mid(a(i, 1), 2, 1) = "M" Then
  8.          Range(i & ":" & i).Delete
  9.       End If
  10.    Next
  11.    n = 1
  12.    a = [a1].CurrentRegion
  13.    col = UBound(a, 2)
  14.    ReDim s(1 To col)
  15.    ReDim av(1 To col)
  16.    For i = 2 To UBound(a)
  17.       d = Day(a(i, 1)): m = Month(a(i, 1))
  18.       If d = 1 Then w = 0
  19.       For j = 2 To col
  20.          If d Mod 7 = 1 Then s(j) = 0
  21.          s(j) = s(j) + a(i, j)
  22.       Next
  23.       If d Mod 7 = 0 Then
  24.          r = r + 1: w = w + 1
  25.          Cells(i + r, 1).EntireRow.Insert
  26.          Cells(i + r, 1) = m & "M" & w & "W"
  27.          For j = 2 To col - 1
  28.             If j = col Then n = 7
  29.             If d = 7 Then av(j) = 0
  30.             Cells(i + r, j) = s(j) / n
  31.          Next
  32.          Cells(i + r, j) = Cells(i + r, j - 1) / Cells(i + r, j - 2)
  33.          Range(Cells(i + r - 7, 1), Cells(i + r - IIf(i + md(m) - d <= UBound(a), 0, 1), 1)).EntireRow.Hidden = True
  34.       End If

  35.       If d = md(m) Then
  36.          r = r + 1
  37.          Cells(i + r, 1).EntireRow.Insert
  38.          Cells(i + r, 1) = m & "M"
  39.          For j = 2 To col
  40.             Cells(i + r, j) = (av(j) + IIf(d <> 28, s(j), 0)) / (w + d Mod 7)
  41.          Next
  42.          Range(Cells(i + r - (d - 1) Mod 7 - 1, 1), Cells(i + r - 1, 1)).EntireRow.Hidden = True
  43.       End If
  44.    Next
  45.    Application.ScreenUpdating = True
  46. End Sub
复制代码

评分

参与人数 1学分 +2 收起 理由
楚雪飞扬 + 2 学习了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-11-25 20:12 | 显示全部楼层

搜狗截图20211125200806.png
现在有另一个问题,就是汇总后目标能不能不保持不变,或是直接填充上一单元格的内容!
回复

使用道具 举报

发表于 2021-11-25 20:51 | 显示全部楼层
不太明白你的意思,能举例说明吗?
回复

使用道具 举报

 楼主| 发表于 2021-11-26 09:12 | 显示全部楼层
本帖最后由 楚雪飞扬 于 2021-11-26 09:26 编辑
大灰狼1976 发表于 2021-11-25 20:51
不太明白你的意思,能举例说明吗?

就是我按你给我提供的代码,放到另一份文件运行时,目标那列数据发生了改变,应该是变成了百分比,代码要怎么改,目标列数值保持不变 ,的有文件目标列不固,有没有办法说,可以指定某一列(目标)的数据保持不变

回复

使用道具 举报

发表于 2021-11-26 10:41 | 显示全部楼层
可以的,你先发个新的附件上来,我要下班后或者明天才能下载确认。
回复

使用道具 举报

 楼主| 发表于 2021-11-26 11:14 | 显示全部楼层
大灰狼1976 发表于 2021-11-26 10:41
可以的,你先发个新的附件上来,我要下班后或者明天才能下载确认。

附件已上传,有两个需要使用到的案例,麻烦老师抽空帮忙弄好,谢谢!

案例.rar

23.9 KB, 下载次数: 1

回复

使用道具 举报

发表于 2021-11-27 15:02 | 显示全部楼层
你附件里的案例1和案例2,和最初的要求完全不一样,需要重新说明一下:
1、案例1里面,目标列如何处理?其他列如何处理?
2、案例2里面,比例列和目标列如何处理?其他列如何处理?
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-11-27 20:25 , Processed in 2.355039 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表