Excel 2019 VBA自定义函数实现连续步骤值汇总求助

• 使用环境：MS Excel 2019
• 实现目标：编写VBA自定义函数，对Steps列、Values列的内容做合并处理：连续重复的步骤项合并为1项，对应位置的数值累加，最终分别输出到Summary Steps（汇总步骤）列、Summary Values（汇总值）列
• 预期效果参考：
  
• 原有自行编写的VBA函数存在逻辑漏洞，运行无法输出正确结果。
• 函数调用方式参考：
  • Summary Steps列公式设置参考：
  • Summary Values列公式设置参考：

• 变量声明不规范：VBA中同一Dim语句内未单独指定类型的变量默认会被定义为Variant类型，和预期的字符串、数值类型不匹配，容易引发隐式类型转换错误
• 数组匹配无容错：按分隔符拆分步骤、值得到两个数组后，未校验数组长度是否一致，遇到格式异常的输入会直接触发下标越界错误
• 遍历逻辑有漏洞：循环过程中未正确处理数组最后一组连续重复项，容易出现值累加遗漏、末尾步骤丢失的问题
• 结果拼接逻辑混乱：拼接结果时冗余保留了开头的分隔符，额外增加的首尾判断逻辑分支多余且容易触发匹配错误

按Alt+F11打开VBA编辑器，插入标准模块，将以下代码粘贴到模块中即可使用：

Function Congdoan_Time(Congdoan As Range, Time As Range, gtri As Boolean) As String
    Dim arrStep As Variant, arrVal As Variant
    Dim i As Long, sumVal As Double
    Dim resStep As String, resVal As String
    Dim lastStep As String
    
    ' 空值直接返回空
    If Congdoan.Value = "" Or Time.Value = "" Then
        Congdoan_Time = ""
        Exit Function
    End If
    
    ' 按分隔符拆分数组
    arrStep = Split(Congdoan.Value, ",")
    arrVal = Split(Time.Value, "-")
    
    ' 校验步骤和值的项数匹配
    If UBound(arrStep) <> UBound(arrVal) Then
        Congdoan_Time = "输入格式错误"
        Exit Function
    End If
    
    ' 初始化第一组数据
    lastStep = arrStep(0)
    sumVal = CDbl(arrVal(0))
    
    ' 从第二项开始遍历判断
    For i = 1 To UBound(arrStep)
        If arrStep(i) = lastStep Then
            ' 连续相同步骤，累加对应值
            sumVal = sumVal + CDbl(arrVal(i))
        Else
            ' 步骤变化，保存上一组汇总结果
            resStep = resStep & "," & lastStep
            resVal = resVal & "-" & sumVal
            ' 重置当前组基准
            lastStep = arrStep(i)
            sumVal = CDbl(arrVal(i))
        End If
    Next i
    
    ' 补充最后一组汇总结果
    resStep = resStep & "," & lastStep
    resVal = resVal & "-" & sumVal
    
    ' 移除开头多余的分隔符
    resStep = Mid(resStep, 2)
    resVal = Mid(resVal, 2)
    
    ' 根据参数返回对应汇总结果
    Congdoan_Time = IIf(gtri, resStep, resVal)
End Function

• 汇总步骤列单元格输入公式：=Congdoan_Time(同行Steps列单元格, 同行Values列单元格, TRUE)
• 汇总值列单元格输入公式：=Congdoan_Time(同行Steps列单元格, 同行Values列单元格, FALSE)
• 输入公式后按回车即可得到结果，下拉公式可批量应用到所有行。

内容的提问来源于stack exchange，提问作者banana