ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 771|回复: 0

请各位老师帮看哈

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-4-8 17:35 | 显示全部楼层 |阅读模式
在运行如下宏时12月份不能自动生成“本月合计”及“本年累计”
其他月份倒是能生成呢。另还想增加一个宏在打印时能增加“过次页”“承前页”


Sub test()
Range("a6:m65536").ClearContents

物料编号 = Range("b2")
Set dic = CreateObject("scripting.dictionary") '本月合计
Set dic1 = CreateObject("scripting.dictionary") '本年累计
rn = Sheets(1).[a1].CurrentRegion
Rng = Sheets(1).[a1].CurrentRegion.Resize(UBound(rn) + 1, UBound(rn, 2))
TR = 5
For r = 2 To UBound(Rng)
  If Rng(r, 3) = 物料编号 Or r = UBound(Rng) Then
        TR = TR + 1
        摘要 = Rng(r, 8)
        If 摘要 = "期初余额" Then
            Cells(TR, 3) = 摘要
            For c = 11 To 13
                Cells(TR, c) = Rng(r, c - 2) 'i -k
                dic(c) = Rng(r, c - 2) '数 量   单 价   金   额
                dic1(c) = Rng(r, c - 2)
            Next c
        Else
            If (Month(Rng(r, 1)) <> m And m <> "") Then
               Cells(TR, 3) = "本月合计"
               For c = 4 To 9
                    Cells(TR, c) = dic(c)
               Next c
               For c = 11 To 13  '余额
                   Cells(TR, c) = dic(c)
               Next c
                  If Cells(TR, 6) <> "" Then Cells(TR, 5) = "=" & Cells(TR, 6) & "/" & Cells(TR, 4)
                  If Cells(TR, 9) <> "" Then Cells(TR, 8) = "=" & Cells(TR, 9) & "/" & Cells(TR, 7)
                  If Cells(TR, 13) <> "" Then Cells(TR, 12) = "=" & Cells(TR, 13) & "/" & Cells(TR, 11)
               Set dic = CreateObject("scripting.dictionary")

               TR = TR + 1
               Cells(TR, 3) = "本年累计"
               For c = 4 To 9
                    Cells(TR, c) = dic1(c)
               Next c
               For c = 11 To 13
                   Cells(TR, c) = dic1(c)
               Next c
                     If Cells(TR, 6) <> "" Then Cells(TR, 5) = "=" & Cells(TR, 6) & "/" & Cells(TR, 4)
                  If Cells(TR, 9) <> "" Then Cells(TR, 8) = "=" & Cells(TR, 9) & "/" & Cells(TR, 7)
                  If Cells(TR, 13) <> "" Then Cells(TR, 12) = "=" & Cells(TR, 13) & "/" & Cells(TR, 11)
                TR = TR + 1
                If r = UBound(Rng) Then GoTo LINE10:
           End If

           Cells(TR, 3) = 摘要
           m = Month(Rng(r, 1))
           Cells(TR, 1) = Rng(r, 1)
           Cells(TR, 2) = Rng(r, 2)

           For c = 4 To 6
              dic(c) = dic(c) + Rng(r, c + 8) '****
              dic1(c) = dic1(c) + Rng(r, c + 8)
              Cells(TR, c) = Rng(r, c + 8)
              dic(c + 7) = dic(c + 7) + Rng(r, c + 8)
              dic1(c + 7) = dic1(c + 7) + Rng(r, c + 8)

           Next c
           For c = 7 To 9
              dic(c) = dic(c) + Rng(r, c + 8)
              dic1(c) = dic1(c) + Rng(r, c + 8)
              Cells(TR, c) = Rng(r, c + 8)
              dic(c + 4) = dic(c + 4) - Rng(r, c + 8)
              dic1(c + 4) = dic1(c + 4) - Rng(r, c + 8)
           Next c
           For c = 11 To 13
                   Cells(TR, c) = dic1(c)
           Next c
                   If Cells(TR, 6) <> "" Then Cells(TR, 5) = "=" & Cells(TR, 6) & "/" & Cells(TR, 4)
                  If Cells(TR, 9) <> "" Then Cells(TR, 8) = "=" & Cells(TR, 9) & "/" & Cells(TR, 7)
                  If Cells(TR, 13) <> "" Then Cells(TR, 12) = "=" & Cells(TR, 13) & "/" & Cells(TR, 11)

        End If



  End If


Next r
LINE10:
For RR = 6 To TR - 1
  If Cells(RR, 13) > 0 Then
             Cells(RR, 10) = "借"
           ElseIf Cells(RR, 13) < 0 Then
             Cells(RR, 10) = "贷"
           Else
             Cells(RR, 10) = "平"
  End If
Next RR

End Sub


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

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-25 07:06 , Processed in 0.023557 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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