三条件汇总

了却无痕

已做到用公式做多条件汇总，但考虑到数据明细太大，希望可以用VB解决问题




多条件求和部分：i4：l15

求和条件1 按月份；
条件2柴油支出下的人工费、加油机维修费、油车加油/维修、杂费

数据源是数据源工作簿的工作表，
条件区域分别是 j列、v列、u列
求和区域是SUM（N6：P99999）-SUM（K6：M99999）

期望大神们的杰作！

3190496160

Sub 柴油利润统计()
Application.ScreenUpdating = False
Dim arr, brr, d
Set d = CreateObject("Scripting.Dictionary")
p = ThisWorkbook.Path & "\"
f = p & "\数据源.xlsx"
Set wb = Workbooks.Open(f, 0)
With wb.Sheets("出纳")
     r = .Cells(Rows.Count, 10).End(xlUp).Row
    arr = Range("a2:v" & r)
    wb.Close False
End With
With Sheets("柴油利润表")
    .Range("h4:n15") = Empty
    br = .Range("a2:n15")
    For j = 8 To 12
        d(br(2, j)) = j
    Next j
    For i = 3 To UBound(arr)
        If arr(i, 10) <> Empty Then
            If IsDate(arr(i, 10)) Then
                yf = Val(Month(arr(i, 10)))
                If InStr(arr(i, 22), "柴油支出") Then
                    lh = d(Trim(arr(i, 21)))
                    If lh <> "" Then
                        br(yf + 2, lh) = br(yf + 2, lh) + arr(i, 19)
                        br(yf + 2, 13) = br(yf + 2, 13) + arr(i, 19)
                    End If
                End If
            End If
        End If
    Next i
    .Range("a2:n15") = br
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

3190496160

新建文件夹.rar (118.6 KB, 下载次数: 12)

2024-1-17 19:40 上传

点击文件名下载附件

了却无痕

3190496160 发表于 2024-1-17 19:40

非常感谢大神 解答了我的疑惑
但您编写的代码运行后 好像出现了一点点的偏移
报表图片中的i4结果应该是1240=1440-200
可以麻烦您再看一看吗？

yynrzwh

年报2.rar (43.34 KB, 下载次数: 13)

2024-1-17 21:06 上传

点击文件名下载附件

了却无痕

yynrzwh 发表于 2024-1-17 21:06

牛皮 想请教大神 要怎么修改才能跟隔壁的对上口号？

yynrzwh

1. With Sheets("柴油利润表")
   
2.     .Range("i4:l15") = ""
   
3.     brr = .Range("a1").CurrentRegion
   
4.     ReDim crr(1 To 12, 1 To 4)
   
5.         For i = 4 To 15
   
6.             For j = 9 To 12
   
7.                 s = brr(i, 1) & brr(3, j)
   
8.                 crr(i - 3, j - 8) = d(s)
   
9.             Next j
   
10.         Next i
    
11.     .Range("i4").Resize(12, 4) = crr
    
12. End With

复制代码

了却无痕

大神 请问如果要这个代码在机械租赁利润表标黄表格中运行 要怎么修改代码呢？

了却无痕

3190496160 发表于 2024-1-17 19:40
Sub 柴油利润统计()
Application.ScreenUpdating = False
Dim arr, brr, d

请问一下大神如果运行区域从i4:L15变更成f40:n51

                         工作表从柴油利润表变更成机械租赁利润表
                         22列条件从柴油支出变更称机械租赁支出
   要修改那些关联代码呢？


我自己改了一版 可是结果为空能麻烦您帮忙看看吗？


Sub 利润统计()
Application.ScreenUpdating = False
Dim arr, brr, d
Set d = CreateObject("Scripting.Dictionary")
p = ThisWorkbook.Path & "\"
f = p & "\数据源.xlsx"
Set wb = Workbooks.Open(f, 0)
With wb.Sheets("出纳")
     r = .Cells(Rows.Count, 10).End(xlUp).Row
    arr = Range("a2:v" & r)
    wb.Close False
End With
With Sheets("机械租赁利润表")
    .Range("f40:n51") = Empty
    br = .Range("a38:n51")
    For j = 6 To 10
        d(br(2, j)) = j
    Next j
    For i = 3 To UBound(arr)
        If arr(i, 10) <> Empty Then
            If IsDate(arr(i, 10)) Then
                yf = Val(Month(arr(i, 10)))
                If InStr(arr(i, 22), "机械租赁支出") Then
                    lh = d(Trim(arr(i, 21)))
                    If lh <> "" Then
                       br(yf + 2, lh) = br(yf + 2, lh) + arr(i, 19)
                        br(yf + 2, 13) = br(yf + 2, 13) + arr(i, 19)
                    End If
                End If
            End If
        End If
    Next i
    .Range("a38:n51") = br
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub