Excel VBA如何实现带范围展开的多分隔符字符串转数组功能

思路说明 #

你提出的循环加判断的实现思路完全可行，逻辑清晰易维护，是该场景下性价比最高的实现方式，无需额外引入复杂语法。

完整修改后代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 关闭事件触发避免递归调用
    Application.EnableEvents = False
    On Error GoTo ErrHandler
    
    Dim KeyCells As Range, R1 As Range
    Set R1 = Range("C6:H319")
    Set KeyCells = R1
    
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        Dim IDnum As String, IDArray() As String, Counter As Integer
        Dim i As Long, Watt As Double, TWatt As Double
        TWatt = 0
        
        ' 原逻辑：按/拆分不同分组
        IDnum = Target.Value
        IDArray() = Split(IDnum, "/")
        
        ' 遍历每个分组，处理范围符
        For Counter = LBound(IDArray) To UBound(IDArray)
            Dim seg As String, segArr As Variant, startNum As Long, endNum As Long, n As Long
            seg = Trim(IDArray(Counter))
            
            ' 判断当前分组是否包含范围符-，需要换成>的话修改此处符号即可
            If InStr(seg, "-") > 0 Then
                segArr = Split(seg, "-")
                startNum = CLng(Trim(segArr(0)))
                endNum = CLng(Trim(segArr(1)))
                ' 遍历生成连续序列
                For n = startNum To endNum
                    i = (n Mod 1000) - (n Mod 100)
                    ' 容错处理：匹配不到型号时跳过不报错
                    On Error Resume Next
                    Watt = Application.WorksheetFunction.Index(Sheets("Fixture List").Range("L3:L10"), _
                        Application.WorksheetFunction.Match(i, Sheets("Fixture List").Range("A3:A10"), 0), 1)
                    If Err.Number = 0 Then TWatt = TWatt + Watt
                    On Error GoTo 0
                Next n
            Else
                ' 无范围符时直接取单个值计算
                n = CLng(seg)
                i = (n Mod 1000) - (n Mod 100)
                On Error Resume Next
                Watt = Application.WorksheetFunction.Index(Sheets("Fixture List").Range("L3:L10"), _
                    Application.WorksheetFunction.Match(i, Sheets("Fixture List").Range("A3:A10"), 0), 1)
                If Err.Number = 0 Then TWatt = TWatt + Watt
                On Error GoTo 0
            End If
        Next Counter
        
        ' 输出总功率
        Target.Offset(1, 12).Value = TWatt
    End If
    
ErrHandler:
    ' 无论是否报错都恢复事件触发
    Application.EnableEvents = True
End Sub

改动说明 #

• 保留了原有按/拆分字符串的逻辑，兼容原有使用习惯
• 新增范围符识别逻辑，默认使用-作为范围标识，如需切换为>只需替换代码中两处-符号即可
• 新增事件开关与匹配容错逻辑，避免修改单元格时重复触发事件、型号匹配不到时程序报错的问题
• 对输入内容自动做Trim去空格处理，兼容输入时带空格的场景

内容的提问来源于stack exchange，提问作者H. Greenland