【原】【代码】VBA自定义汇总函数mySum：一个单元格多关键字数据查询汇总，两种思路

快速浏览

实用案例

|日期控件||简单的收发存||收费管理系(Access改进版)|

|电子发票管理助手||电子发票登记系统(Access版)|

|文件合并||表格拆分||审计凭证抽查底稿|

|中医诊所收费系统(Excel版)||中医诊所收费系统(Access版)||银行对账单自动勾对|

|印章使用登记系统|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划||新税法下工资表模版|

内容提要

• 自定义汇总函数|完整代码

1、在模块myModule里，自定义函数mySum：

Function mySum(keyRange As Variant, sumRange As Range, Optional delimiter As String = "+")    Dim rng As Range, arr(), arrKey() As String, keyWords As String    Dim lastRow As Long, lastCol As Long    Dim materialCode As String    Dim temp As Double        If VarType(keyRange) = vbString Then        keyWords = keyRange    ElseIf TypeOf keyRange Is Range And keyRange.Cells.Count = 1 Then        keyWords = CStr(keyRange.Value)    Else        mySum = "Err: 错误的关键字"        Exit Function    End If    '//选择区域缩减范围    With sumRange        lastRow = .Parent.UsedRange.Rows.Count        lastCol = .Columns.Count        Set rng = .Cells(1, 1).Resize(lastRow, lastCol)        arr = rng.Value    End With    '//关键字前后加上分隔符    keyWords = delimiter & keyWords & delimiter    For i = 1 To UBound(arr)        materialCode = delimiter & arr(i, 1) & delimiter        If InStr(keyWords, materialCode) > 0 Then            temp = temp + arr(i, lastCol)        End If    Next    mySum = tempEnd Function

2、在模块myModule里，自定义函数mySumD：

Function mySumD(keyRange As Variant, sumRange As Range, Optional delimiter As String = "+")    Dim rng As Range, arr(), arrKey() As String, keyWords As String    Dim dic As Object, dkey As String, lastRow As Long, lastCol As Long    Dim currValue As Variant    Set dic = CreateObject("Scripting.dictionary")    If VarType(keyRange) = vbString Then        keyWords = keyRange    ElseIf TypeOf keyRange Is Range And keyRange.Cells.Count = 1 Then        keyWords = CStr(keyRange.Value)    Else        mySumD = "Err: 错误的关键字"        Exit Function    End If        With sumRange        lastRow = .Parent.UsedRange.Rows.Count        lastCol = .Columns.Count        Set rng = .Cells(1, 1).Resize(lastRow, lastCol)        arr = rng.Value    End With        For i = 1 To UBound(arr)        dkey = arr(i, 1)        currValue = arr(i, lastCol)        If IsNumeric(currValue) Then            dic(dkey) = dic(dkey) + currValue        End If    Next    arrKey = Split(keyWords, delimiter)        For i = 0 To UBound(arrKey)        dkey = arrKey(i)        mySumD = mySumD + dic(dkey)    Next    End Function

这两个自定义函数mySum、mySumD，效果是一样的，只是采用了不同的实现方式。