我们在日常生活中常有这样的求和
多条件求和
我们常用函数是sumif,sumifs,sumproduct
我认为输入公式计算多条件求和时有点复杂，所以我想能不能搞个简单一点的
想了想，搞一个吧，练练手
代码语言：javascript复制'传入一维数组和标题，返回标题在数组中的位置
Function StrToId(inarr, s)
Dim t_m%
On Error Resume Next
t_m = Application.WorksheetFunction.Match(s, inarr, 0)
If Err = 0 Then
StrToId = t_m
Else
StrToId = 0
End If
On Error GoTo 0
End Function
'=MultiConTosum(数据全区域,条件标题区域,求和标题,条件区域)
'例：=MultiConTosum($A$1:$J$13,$B$21:$C$21,D$21,$B22:$C22)
'1.数据全区域----绝对引用区域第一列第一行开始（一定含标题行）
'2.条件标题区域--绝对引用条件标题
'3.求和标题------列绝对引用求和标题（一个单元格）
'4.条件区域------行绝对引用
Function MultiConTosum(dataRng As range, conTitleRng As range, sumRng As range, conRng As range)
Dim data_arr, data_arr1, con_arr, t_Array()
Dim t_num, y, k As Integer, sumStr As String, rr As range, gotoNext As Boolean, get_Col As Integer
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
data_arr = dataRng.Value
data_arr1 = Application.Index(data_arr, 1, 0)
con_arr = conRng.Value
t_num = Application.WorksheetFunction.CountA(conTitleRng)
k = 1
gotoNext = True
If t_num > 0 Then
ReDim t_Array(1 To t_num)
sjoin = Join(Application.Index(con_arr, 1, 0), "")
dic(sjoin) = 0
For Each rr In conTitleRng
If rr <> "" Then
t_Array(k) = StrToId(data_arr1, rr.Value)
k = k 1
End If
Next
Else
gotoNext = False
End If
get_Col = StrToId(data_arr1, sumRng.Value)
If get_Col = 0 Then gotoNext = False
If gotoNext = False Then
MultiConTosum = 0
Else
For k = 2 To UBound(data_arr)
s = Join(Application.Index(data_arr, k, t_Array), "")
If dic.exists(s) Then dic(s) = dic(s) data_arr(k, get_Col)
Next k
MultiConTosum = dic(sjoin)
End If
End Function【效果】
