[已解决]如何根据指定的月份统计当月的合计数？

蝶·舞 · 发表于 2012-10-15 15:10

本帖最后由蝶·舞于 2012-10-15 15:11 编辑

快照1.jpg

左图的数据根据右图中指定的月份统计出该月的借方和贷方的分别发生合计数，我知道用高版本的sumifs可以实现，用数透也可以实现。但毕竟不是都用高版本的office，而用数透的话，容易将右侧的表格格式破坏。因为数据量比较大，在2003中使用公式的话，容易导致卡机，所以求一段代码。

示例.zip (4.23 KB, 下载次数: 24)

无聊的疯子 · 发表于 2012-10-15 15:19

很多项目不存在啊，就是分月分类求和计么？？

你也不弄个结果出来，不是会计还不怎么懂你这是怎么和计的呢

爱疯 · 发表于 2012-10-15 15:32

Sub 按钮1_Click()
Dim A, B, i, j
A = Sheet1.Range("a1").CurrentRegion
B = Sheet2.Range("a3").CurrentRegion
Sheet2.Range("b4").Resize(UBound(B), UBound(B, 2)).ClearContents
B = Sheet2.Range("a3").CurrentRegion
For i = 1 To UBound(B)
      For j = 1 To UBound(A)
         If B(i, 1) = A(j, 2) Then
            B(i, 2) = B(i, 2) + A(j, 3)
            B(i, 3) = B(i, 3) + A(j, 4)
         End If
      Next j
Next i
Sheet2.Range("a3").Resize(UBound(B), UBound(B, 2)) = B
End Sub

示例2.rar (11.61 KB, 下载次数: 24)

无聊的疯子 · 发表于 2012-10-15 15:33

试试看这结果对不？

Sub 合计()
Dim D As Object, Mo As Byte, H As Long
Dim Hx As Long, Arr(), Brr()
Set D = CreateObject("scripting.Dictionary") '创建一个字典
With Sheets("Sheet2") '指定操作 Sheet2 表
Mo = .Range("B1").Value '记录月
Hx = .Range("A65536").End(xlUp).Row '提取使用行数
.Range("B4:C" & Hx).ClearContents '清除结果
Arr = .Range("A4:C" & Hx).Value '将数据区域交给数组
For Hx = 1 To UBound(Arr)
D(Arr(Hx, 1)) = Hx '循环，将科目所在行号交到字典中
Next
With Sheets("Sheet1") '操作 Sheet1 表,提取数据源
Hx = .Range("A65536").End(xlUp).Row
Brr = .Range("A2:D" & Hx)
End With
For Hx = 1 To UBound(Brr) '循环数据源
If Brr(Hx, 1) = Mo Then '如果月相同
H = D.Item(Brr(Hx, 2)) '在字典中提取科目所在行
Arr(H, 2) = Brr(Hx, 3) + Arr(H, 2) '借方累加
Arr(H, 3) = Brr(Hx, 4) + Arr(H, 3) '贷方累加
End If
Next
.Range("A4").Resize(UBound(Arr), 3) = Arr '将结果写回单元格
End With
End Sub

复制代码

zjdh · 发表于 2012-10-15 15:36

本帖最后由 zjdh 于 2012-10-15 15:45 编辑

Sub TEST()
ARR = Sheet1.Range("A2:D" & Sheet1.Range("A65536").End(3).Row)
With Sheet2
      .Range("B4:C100").ClearContents
      BRR = .Range("B4:C" & .Range("A65536").End(3).Row)
      Y = .Range("B1")
      For I = 1 To UBound(ARR)
         For J = 1 To UBound(BRR)
            If ARR(I, 1) = Y And ARR(I, 2) = BRR(J, 1) Then
                  BRR(J, 2) = BRR(J, 2) + ARR(I, 3)
                  BRR(J, 3) = BRR(J, 3) + ARR(I, 4)
                  Exit For
            End If
         Next
      Next
      .Range("A4").Resize(UBound(BRR), 3) = BRR
End With
End Sub

示例.rar (8.53 KB, 下载次数: 81)

蝶·舞 · 发表于 2012-10-15 15:39

无聊的疯子发表于 2012-10-15 15:33
试试看这结果对不？

中断在这句

Brr = .Range("A2:D" & Hx)

复制代码

蝶·舞 · 发表于 2012-10-15 15:42

爱疯发表于 2012-10-15 15:32
Sub 按钮1_Click()
Dim A, B, i, j
A = Sheet1.Range("a1").CurrentRegion

不是累计，如果我指定是1月份，则只统计1月份的发生额，如果我指定2月份，则只统计2月份的发生额（而不是1，2月份的累计额）

zjdh · 发表于 2012-10-15 15:44

5楼附件已更新 .

		自动登录	找回密码
密码			注册

[已解决]如何根据指定的月份统计当月的合计数？

点评