如何用VBA写出多条件求和

shinechou86

如图，A列是产品类型，B列是销售日期，C列是销售额，如何在销售合计一栏写出，类似于-A列 ，"E2"，B列，">=F2","<=G2",求和C列的多条件求和？

3190496160

Sub 多条件汇总()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:c" & r)
    rs = .Cells(Rows.Count, 5).End(xlUp).Row
    br = .Range("e1:h" & rs)
    For i = 2 To UBound(br)
        hj = 0
        If Trim(br(i, 1)) <> "" And br(i, 2) <> "" And br(i, 3) <> "" Then
            ks = CDate(br(i, 2))
            js = CDate(br(i, 3))
             For s = 2 To UBound(ar)
                If Trim(ar(s, 1)) = Trim(ar(i, 1)) And DateValue(ar(s, 2)) >= DateValue(ks) And DateValue(ar(s, 2)) <= DateValue(js) Then
                    hj = hj + ar(s, 3)
                End If
            Next s
            br(i, 4) = hj
        End If
    Next i
    .Range("e1:h" & rs) = br
End With
MsgBox "ok!"
End Sub

3190496160

产品销售统计.rar (18.61 KB, 下载次数: 81)

2021-11-21 11:32 上传

点击文件名下载附件

shinechou86

3190496160 发表于 2021-11-21 11:31
Sub 多条件汇总()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row

很工整的代码，两个数组全搞定！

xiangbaoan

1. Sub test1()
   
2.   Dim ar, br, cr, Dict As Object, dt As Date, i As Long
   
3.   Set Dict = CreateObject("Scripting.Dictionary")
   
4.   ar = Range("E1").CurrentRegion
   
5.   For i = 2 To UBound(ar)
   
6.     ar(i, 4) = 0
   
7.     Dict(ar(i, 1)) = Array(i, CDate(ar(i, 2)), CDate(ar(i, 3)))
   
8.   Next
   
9.   br = Range("A1").CurrentRegion
   
10.   For i = 2 To UBound(br)
    
11.     If Dict.Exists(br(i, 1)) Then
    
12.       cr = Dict(br(i, 1))
    
13.       dt = CDate(br(i, 2))
    
14.       If dt >= cr(1) Then If dt <= cr(2) Then ar(cr(0), 4) = ar(cr(0), 4) + br(i, 3)
    
15.     End If
    
16.   Next
    
17.   Range("E1").CurrentRegion = ar
    
18.   Set Dict = Nothing
    
19. End Sub

复制代码

hzqhxy

附件供参考

准提部林

Sub TEST_A1()
Dim Arr, Brr, xD, i&, j%, R&, D
Set xD = CreateObject("Scripting.Dictionary")
Brr = Range([h2], [e65536].End(3)(2))
For i = 1 To UBound(Brr) - 1
    xD(Brr(i, 1)) = i: Brr(i, 1) = 0
    Brr(i, 2) = CDate(Brr(i, 2)): Brr(i, 3) = CDate(Brr(i, 3))
Next i
Arr = Range([a1], [c65536].End(3))
For i = 2 To UBound(Arr)
    R = xD(Arr(i, 1)): D = CDate(Arr(i, 2))
    If R = 0 Then GoTo i01
    If D >= Brr(R, 2) And D <= Brr(R, 3) Then Brr(R, 1) = Brr(R, 1) + Arr(i, 3)
i01: Next i
[h2].Resize(UBound(Brr) - 1) = Brr
End Sub

CYZ凡星点点

hzqhxy 发表于 2021-11-21 16:31
附件供参考

感谢分享