[总结]VBA中多条件求和中SUMPRODUCT问题

breezy

       我们知道在EXCEL中多条件求和可以使用sumproduct公式求值，但在VBA中使用
Application.WorksheetFunction.SumProduct，却提示类型不匹配，似乎VBA就不支持此写法，经过多方收集，总结至少可以使用以下六种来替代求解，达到多条件求和的目的。

年份	类型	售价		2006年A型总售价
2006	A	1000	公式结果:	1950
2006	B	1200
2006	C	1100
2006	A	950	VBA方法一:	1950
2007	A	1050	VBA方法二:	1950
2007	B	1050	VBA方法三:	1950
2008	C	1200	VBA方法四:	1950
			VBA方法五:	1950
			VBA方法六:	1950

       如上为表格数据：我们想求得2006年A型总售价，在EXCEL中可以使用公式：=SUMPRODUCT((A2:A8=2006)*(B2:B8="A")*(C2:C8))解得。

VBA中解法如下：

'VBA方法一---利用EXCEL公式法:
Sub breezy_method_1()
    Range("E5").Formula = "=SumProduct((A2:A8=2006)*(B2:B8=""A"")*(C2:C8))"
    '加入以下这句可实现公式转化为值
    'Range("E5") = Range("E5").Value
End Sub

'VBA方法二---直接利用公式求值:
Sub breezy_method_2()
    Range("E6").Value = [SumProduct((A2:A8 = 2006) * (B2:B8 = "A") * (C2:C8))]
End Sub

'VBA方法三---利用Evaluate求值:
Sub breezy_method_3()
    Range("E7").Value = Evaluate("SumProduct((A2:A8=2006)*(B2:B8=""A"")*(C2:C8))")
End Sub

'VBA方法四---SQL查询求值:
Sub breezy_method_4()
    Dim SQL As String
    Set xx = CreateObject("adodb.connection")
   
    slastline = [a65536].End(xlUp).Row

    xx.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    SQL = "select sum(售价) from [Sheet1$] where 年份=2006 and 类型=""A"""
   
    Set yy = xx.Execute(SQL)
    'MsgBox yy.fields(0)
   
    Range("E8").CopyFromRecordset yy
   
    Set yy = Nothing
    Set xx = Nothing
End Sub

'VBA方法五---数组循环求值:
Sub breezy_method_5()
    Dim aw
    Dim i%, aCount%, iRow$, s1%, s2$
    aCount = 0
    s1 = 2006
    s2 = "A"
    iRow = Range("A65536").End(xlUp).Row
    aw = Cells(2, 1).Resize(iRow - 1, 3)
    For i = 1 To iRow - 1
        If aw(i, 1) = s1 And aw(i, 2) = s2 Then
            aCount = aCount + aw(i, 3)
        End If
    Next i
   
    Range("E9") = aCount
End Sub

'VBA方法六---单元格循环求值:
Sub breezy_method_6()
    Dim i%, aCount%, iRow$, s1%, s2$
    aCount = 0
    s1 = 2006
    s2 = "A"
    iRow = Range("A65536").End(xlUp).Row
    For i = 2 To iRow - 1
        If Cells(i, 1) = s1 And Cells(i, 2) = s2 Then
            aCount = aCount + Cells(i, 3)
        End If
    Next i
   
    Range("E10") = aCount
End Sub

PS：第一次在『 Excel 程序开发 』 版发主题贴，还望诸位GG、JJ、DD、MM不吝赐教，欢迎大家交流讨论，跟贴支持，小弟谢过！～

breezy

附件如下：

monWTX1G.rar (9.32 KB, 下载次数: 1169)

2007-1-19 16:48 上传

点击文件名下载附件
[总结]VBA中多条件求和中SUMPRODUCT问题

breezy

再来一法。

'VBA方法七---利用自动筛选求解:
Sub breezy_method_7()
    With Cells
        .AutoFilter Field:=1, Criteria1:="2006"
        .AutoFilter Field:=2, Criteria1:="A"
        .Range("E11") = Application.WorksheetFunction.Subtotal(9, .Range("C:C"))
        .AutoFilter
    End With
End Sub

向您问好

谢谢breezy分享

yfxpzq

方法不错,如数据量多,代码也慢.后三个好!

ifhwfu

很不错！谢谢分享！

ifhwfu

谢谢！很不错阿！

冰山上的来客

呵呵，总结得好。

爱歌学习

[em17]

yvhf

谢谢breezy朋友，分享，收藏了