按条件求和，根据每个部门统计月份小计

aellu · 发表于 2018-9-5 13:37

按照条件求和Function过程，根据每个部门统计月份小计。
自己写了个但是不对求解。。。

qiuhe.rar (18.92 KB, 下载次数: 9)
QQ截图20180905133349.png

Function AAA(a As Range, b As Range)
Dim i&, n&
Dim arr, brr
Dim d As Object
Dim ws As Worksheet
Set d = CreateObject("scripting.dictionary")
For Each ws In Worksheets
If ws.Name = a Then
ws.Select
d.RemoveAll
With ws
r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
brr = .Range("a1:k" & r)
arr = .Range("a1:k" & r)
For i = 4 To Range("B65536").End(xlUp).Row
If brr(i, 1) = b Then
For n = i To Range("B65536").End(xlUp).Row
If arr(n, 2) = "小计" Then
d(arr(n, 2)) = d(arr(n, 2)) + arr(n, 3)
End If
If Right(arr(n, 1), 1) = "月" Then GoTo X
Next
End If
Next
X:
AAA = Application.Sum(d.items)
End With
End If
Next
End Function

复制代码

chxw68 · 发表于 2018-9-5 14:27

Sub test()
Dim r%, i%
Dim arr, brr
Dim ws As Worksheet
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For Each ws In Worksheets
If ws.Name <> "Sheet1" Then
ReDim brr(1 To 13)
brr(1) = ws.Name
With ws
r = .Cells(.Rows.Count, 2).End(xlUp).Row
arr = .Range("a1:c" & r)
For i = 1 To UBound(arr)
If arr(i, 1) Like "*月" Then
n = Val(arr(i, 1)) + 1
End If
If arr(i, 2) = "小计" Then
brr(n) = brr(n) + arr(i, 3)
End If
Next
End With
d(ws.Name) = brr
End If
Next
With Worksheets("sheet1")
.Rows("3:" & .Rows.Count).ClearContents
.Range("a3").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
End With
End Sub

复制代码

chxw68 · 发表于 2018-9-5 14:28

详见附件。

aellu · 发表于 2018-9-7 17:07

chxw68 发表于 2018-9-5 14:28
详见附件。

谢谢大师！！！！

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

[求助] 按条件求和，根据每个部门统计月份小计