关于计划期完成率环比同比增长率的求助，谢谢！

hcy1185

论坛各位老师你们好！
关于计划期完成率环比同比增长率的求助，工作簿里每年度一个工作表，第二个工作表是统计计划期的计划数、完成数、完成率、环比、同比、与奋斗目标占比列，工作簿内有部分代码，能够计算月度的各项计算，本人对vba代码仅知道一点皮毛，好的问题还需要来论坛求助各位老师，请版主老师们指教，谢谢！！！

LIUZHU

感觉用公式做更方便些

hcy1185

主要是想学习一下VBA，嘿嘿

yynrzwh

感觉用字典好点

yynrzwh

做了月的，仅供参考
生产经营计划完成率环比同比增长率(hcy) - 2.zip (56.12 KB, 下载次数: 5)

2024-3-29 11:32 上传

点击文件名下载附件

hcy1185

yynrzwh 发表于 2024-3-29 11:33
做了月的，仅供参考

谢谢，运行中断

hcy1185

已经完善，有需要的可以参考

hcy1185

需要的朋友可以复制

Sub 计算计划期完成率环比同比增长率()
    '环比:可以直观的反映阶段性的变化，但会受季节性因素的影响；
    '同比:可以排除季节性因素的影响。
    Dim ws As Worksheet
    Dim arr As Variant, brr As Variant, shuzu As Variant, Crr As Variant
    Dim i As Integer, j As Integer
    If ThisWorkbook.Name <> "生产经营计划完成率环比同比增长率(huangcy).xlsm" Then Exit Sub '唉，还要加上后缀
    'Arr是本年度工作表数组、Brr是上年度工作表数组、shuzu是合并后的数组、Crr是准备写入sheet2工作表的数组
    Worksheets("完成率环比同比增长率").Activate '激活sheet2工作表
    If Range("g1") = "" Or Range("h1") = "" Then Exit Sub
    '3个一维数组合并为1个二维数组
    Dim br, cr, dr, er, x
    br = Array("1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "1季度", "2季度", "3季度", "4季度", "上半年", "下半年", "全年")
    cr = Array(28, 30, 32, 34, 36, 38, 40, 42, 44, 46, 48, 50, 28, 34, 40, 46, 28, 40, 28) '按当年所在列排的
    dr = Array(29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 33, 39, 45, 51, 39, 51, 51)
    er = Array(br, cr, dr)
    er = Application.Transpose(er) '二维数组转置
    'Arr、Brr两个数组的确定
    For Each ws In ThisWorkbook.Sheets
        If InStr(ws.Name, Sheet2.Range("g1")) <> 0 Then '如果工作表名称包含"G1单元格内容"
            arr = ws.Range("d3:aa" & ws.Range("b65536").End(xlUp).Row) '本年度，不要左边的行标题
        ElseIf InStr(ws.Name, (Left(Sheet2.Range("g1"), 4) - 1) & "年") <> 0 Then
            brr = ws.Range("a3:aa" & ws.Range("b65536").End(xlUp).Row) '上年度
        End If
    Next ws
    shuzu = Join_shuzu(brr, arr) '二维数组合并二维数组
    Range("a3:k" & Range("b65536").End(xlUp).Row).ClearContents '清理区域中的公式和值
    '循环数组shuzu、er
    Dim shuzui
    Dim jhhj, wchj, sywc, snwc 'jhhj计划合计, wchj完成合计, sywc上月完成（环比用）, snwc上年计完成（同比用）
    Dim sum_jhhj, sum_wchj, sum_sywc, sum_snwc
    'On Error Resume Next '容错语句
    ReDim Crr(1 To UBound(shuzu), 1 To 11) '重定义shuzu数组大小
    For shuzui = 1 To UBound(shuzu) '循环shuzu
        x = 24
        jhhj = 0: wchj = 0: sywc = 0: snwc = 0
        For i = 1 To UBound(er) '循环er的行
            If Range("$H$1") = er(i, 1) Then
                For j = er(i, 2) To er(i, 3) Step 2 '循环er的列,步长2
                    jhhj = jhhj + shuzu(shuzui, j)    '计划
                    wchj = wchj + shuzu(shuzui, j + 1) '完成
                    sywc = sywc + shuzu(shuzui, j - (er(i, 3) - er(i, 2))) '上月完成
                    snwc = snwc + shuzu(shuzui, j - x + 1) '上年完成
                Next j
            End If
        Next i
        sum_jhhj = jhhj '计划
        sum_wchj = wchj '完成
        sum_sywc = sywc '上月完成
        sum_snwc = snwc '上年完成
        Crr(shuzui, 1) = shuzu(shuzui, 1)
        Crr(shuzui, 2) = shuzu(shuzui, 2)
        Crr(shuzui, 3) = shuzu(shuzui, 3)
        Crr(shuzui, 4) = sum_jhhj
        Crr(shuzui, 5) = sum_wchj
        Crr(shuzui, 10) = sum_sywc '这两行可以不写入单元格
        Crr(shuzui, 11) = sum_snwc
        'Format(Range("a3"), "0.00%")百分比格式
        If sum_jhhj > 0 Then Crr(shuzui, 6) = Format(sum_wchj / sum_jhhj, "0.00%") Else Crr(shuzui, 6) = "" '完成率
        If sum_sywc > 0 Then Crr(shuzui, 7) = Format((sum_wchj - sum_sywc) / sum_sywc, "0.00%") Else Crr(shuzui, 7) = "" '环比
        If sum_snwc > 0 Then Crr(shuzui, 8) = Format((sum_wchj - sum_snwc) / sum_snwc, "0.00%") Else Crr(shuzui, 8) = "" '同比
        If Sheet1.Cells(2 + shuzui, "f") > 0 Then Crr(shuzui, 9) = Format(sum_wchj / Sheet1.Cells(2 + shuzui, "f"), "0.00%") '与力争目标占比
    Next shuzui
    Range("a3").Resize(UBound(Crr, 1), 9) = Crr 'drr数组回填到单元格区域
End Sub