Excel VBA自定义函数 根据条件连接字符串

做excel发现现有的函数功能不够用,就自学了一下VBA写了第一个新函数:根据条件连接字符串
比如count()有countif()和countifs(),sum()有sumif()和sumifs(),但是concatenate()却没有类似concatenateifs()的函数,于是自己写了个替代品
(写的解释比较面向初学者,如果是只需要参考,完全可以跳过直接看代码块)

问题:我需要在选区中找出同时符合两个条件的值,比如

地区调料
沙滩咸鱼
海沟深海鱼酱油
海沟深海鱼芥末
火星深海鱼沙子
这其中地区和名称同时相同的视为同一种鱼,那么海沟的深海鱼既可以用酱油也可以用芥末,在新的表中需要将这一项合并,也就是说处理后的新表如下:
地区调料
沙滩咸鱼
海沟深海鱼酱油芥末
火星深海鱼沙子
实现:
首先排个序会比较清晰,将要统计的地区和鱼录入新表(我自己的做法是直接复制到新表,再去除重复值),然后对调料使用函数自动填充
自定义的函数concatenate_ifs()仿照countifs()来设定参数,countifs()的语法就不说了
使用参数给它起个名字
需要合并的字符串所在单元格列,即表1的调料列concatenate_range
范围1,即表1的地区列range1
条件1,即表2要去匹配的地区单元格criteria1
范围2,即表1的鱼列range2
条件2,即表2要去匹配的鱼criteria2

函数的使用,在表2的调料一格填充:
=concatenate_ifs(表1!调料:调料,表1!地区:地区,表2!地区1,表1!鱼:鱼,表2!鱼1)
剩下的格子自动填充即可

自定义函数的VBA代码:

'思路:
'先在range1中查找criteria1,找到了就记录是第几行,存为rowNum
'在满足条件1的记录行中找满足条件2的行,即range2中查criteria2
'查到的行会同时满足条件1、2,将行中对应的内容拼起来
Function concatenate_ifs(concatenate_range As Range, range1 As Range, criteria1 As String, range2 As Range, criteria2 As String)
	'range类型是单元格
    'Stop
    'Stop是用来调试的
    Dim rowNum As Integer
    rowNum = 1
    Dim r1 As Range
    Dim res As String
    res = ""
    For Each r1 In range1
        If r1 = criteria1 Then
            rowNum = r1.Row
            If range2.Cells(rowNum) = criteria2 Then
                res = res & concatenate_range.Cells(rowNum)
                '使用&合并字符串
            End If
        End If
    Next r1
    concatenate_ifs = res
End Function

这样写缺点是效率太低了点,很卡,因为VBA引用单元格cells比数组和字典慢很多,于是优化,用数组来计算:

Function concatenate_ifs(concatenate_range As Range, range1 As Range, criteria1 As String, range2 As Range, criteria2 As String)
    'Stop '断点调试
    Dim rowNum As Integer
    Dim ub As Integer
    ub = WorksheetFunction.CountIf(range1, "<>")
    '将循环次数缩减为有内容的单元格
    '如果表内有空白值要删除换成ubound(range1)
    Dim res As String
    res = ""
    Dim rr1(), rr2(), c_r()
    rr1 = range1
    rr2 = range2
    c_r = concatenate_range
    '要注意Excel将单元格导入数组会按照单元格本身的形式
    '比如这里将整列导入数组,数组的样子也是一列,而不是一维数组
    For rowNum = 1 To ub
        If rr1(rowNum, 1) = criteria1 Then
            If rr2(rowNum, 1) = criteria2 Then
                If c_r(rowNum, 1) <> "" Then
                    res = res & c_r(rowNum, 1)
                End If
            End If
        End If
    Next rowNum
    concatenate_ifs = res
End Function

使用数组的计算速度要快很多
针对要分析的数据的结构改进函数也能省略许多不需要计算的值
使用函数的时候选择的范围更精确一些也能提高计算速度

  • 3
    点赞
  • 14
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
VBA中,自定义函数可以通过查询值返回多个值。一种常见的方法是使用数组来存储和返回多个值。下面是一个示例代码,演示了如何通过查询值返回多个值: ```vba Function GetMultipleValues(query As String) As Variant ' 定义一个数组来存储多个值 Dim result() As Variant Dim i As Integer ' 假设你的查询逻辑在这里,将查询的结果存储在数组中 ' 这里只是一个示例,你可以根据实际需求进行修改 If query = "A" Then ReDim result(1 To 2) ' 定义数组的大小 result(1) = "Value 1" result(2) = "Value 2" ElseIf query = "B" Then ReDim result(1 To 3) ' 定义数组的大小 result(1) = "Value 3" result(2) = "Value 4" result(3) = "Value 5" End If ' 返回存储多个值的数组 GetMultipleValues = result End Function ``` 在上面的示例中,自定义函数`GetMultipleValues`接受一个字符串参数`query`作为查询条件。根据不同的查询条件,函数将结果存储在名为`result`的数组中。最后,函数返回这个数组。 要在VBA中使用这个自定义函数,你可以在Excel或其他VBA环境中调用它。例如,在Excel单元格中输入`=GetMultipleValues("A")`,将返回一个包含两个值的数组。 请注意,自定义函数的返回值类型是`Variant`,因为它可以是任何类型的数组。在使用函数的结果时,请根据实际需要进行类型转换。 希望这个示例能对你有所帮助!如果你有任何其他问题,请随时提问。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值