只有一些更正，请。检查。标记更改和添加。

Dim sH As String       'Added
Sub ParseCell()
' Set the input range where your values are
Dim inputRange As Range, outputCell As Range, inputArea As Range
Dim inputCell As Variant
Dim startNum As Long, endNum As Long
Dim i As Long
Dim resList  As String
Debug.Print "Selection_change"

Set inputRange = Selection.Columns(1) ' Added Use the selected range as input

' Set the output range where you want the split references
Set outputCell = inputRange.Offset(0, 1).Cells(1) ' Output in the column next to the input

    ' Loop through each area in the input range
    resList = ""
    For Each inputArea In inputRange.Areas
        ' Loop through each cell in the area
        For Each inputCell In inputArea
            Set outputCell = inputCell.Offset(0, 1).Cells(1)
            ' Split the value by dash
            Dim parts() As String
            If Len(inputCell.Value) > 0 Then
                resList = ""
            ElseIf Len(inputCell.Value) = 0 Then ' blank cell
                Debug.Print "blank"
                'the same as previous
                'resList = resList
            ElseIf IsEmpty(inputCell) Then
                Debug.Print "empty"
                resList = ""
            End If
            If Len(inputCell.Value) > 0 Then
                parts = Split(Replace(inputCell.Value, ",", " "), " ")
                For i = LBound(parts) To UBound(parts)
                    If Len(Trim(parts(i))) > 0 Then
                        resList = resList & ExpandCellsList(Trim(parts(i))) & " "
                    End If
                Next i
                If Len(resList) > 0 Then resList = Left(resList, Len(resList) - 1): outputCell.Value = resList  'Moved here
            End If
            Debug.Print outputCell.Address, resList
        Next inputCell
    Next inputArea
End Sub

Public Function ExpandCellsList(cl As String) As String
Dim i As Long
Dim sv1 As String, sv2 As String, shdepo As String   'Added
Dim startNum As Long, endNum As Long
Dim res As String
    i = InStr(1, cl, "-")
    If i > 0 Then
        sv2 = Trim(Mid(cl, i + 1))
        shdepo = sH
        sH = Trim(Left(cl, i - 1))
        For i = 1 To Len(sH)
            If InStr(1, "01234567890", Mid(sH, i, 1)) > 0 Then
                sv1 = Trim(Mid(sH, i))
                sH = Trim(Left(sH, i - 1))
                If Len(sH) = 0 Then sH = shdepo   'Added
                Exit For
            End If
        Next i
        If Len(sv2) < Len(sv1) Then
            sv2 = Left(sv1, Len(sv1) - Len(sv2)) & sv2
        End If
        startNum = Val(sv1)
        endNum = Val(sv2)
        If endNum > startNum Then
            For i = startNum To endNum
                res = res & sH & CStr(i) & " "
            Next i
        End If
        If Len(res) > 0 Then res = Left(res, Len(res) - 1)
        ExpandCellsList = res
    Else
        sH = Left(Trim(cl), 1)    'Added
        ExpandCellsList = cl
    End If
End Function

这里的总体思路是首先得到字母（s），然后分别处理数字。然后，在结果字符串中，将在数字之前添加字母。让我们看看它是如何完成的。
首先在VB编辑器中添加一些引用。转到“工具”-“参考”并添加这些：

• Microsoft脚本运行时（用于字典、集合）
• Microsoft VBScript Regular Expressions 5.5（用于RegEx模式）

“ConvertReferences”过程首先填充客户端可能使用的分隔符字典：这可以是逗号、空格、分号等。但不是破折号。这是一本名为《替代品》的词典。
接下来，我们创建一个匹配第一个字母的RegEx模式。我们存储字母并继续数字。
现在“ParseOneCell”函数用于遍历选区中的每个单元格。我们去掉空格，标准化分隔符（使用“替换”字典），并使用标准分隔符（空格）得到数组“Arr”。“Arr”的值将进一步向下分析。我们将使用此数组中的项目来填充“Numbaz”集合。
在“Arr”数组中，我们可以有两种情况：1）带连字符的数字，2）单个数字。在第一种情况下，我们将使用“RangeFromNumbers”函数来创建一个很好的值范围，然后将其添加到“Numbaz”集合中。如果这是情况2，我们只需将数字转储到“Numbaz”集合。
在“RangeFromNumbers”函数中，特别注意处理缩短的数字，如7-11或103-7。对于像“7-11”这样的情况，我们创建了一个从第一个到最后一个数字的临时集合。对于像103-7这样的情况，我们使用“GetNumEndFromShortened”函数，将数字转换为字符串，反转它们并获得107作为最后一个数字，然后在“RangeFromNumbers”中使用它来生成所需的范围。
一旦“Numbaz”被填充了数字范围，我们就可以在它们前面加上字母代码，从而创建“Result”字符串。

Option Explicit

' Add references
' Tools - References:
' - Microsoft Scripting Runtime
' - Microsoft VBScript Regular Expressions 5.5

Public Replacements As Dictionary
Public Numbaz As Collection
Public re1 As RegExp

Sub ParseCellsRange()
    
    Dim RgIn As Range
    Dim cell As Range
    Dim ArrOut As Variant
    
    ' Fill the dictionary with all the separators the client might use
    Call FillReplacements
    
    ' Create RegExp pattern
    Set re1 = New RegExp
    With re1
        .Pattern = "[a-zA-Z]+\d?" ' any letters followed by one digit
        .Global = False ' find first
        .IgnoreCase = True
    End With
    
    Set RgIn = Selection
    For Each cell In RgIn
        If Trim(cell.Value) <> "" Then
            cell.Offset(0, 1) = ParseOneCell(cell.Value)
        End If
    Next cell
    
End Sub

Private Function ParseOneCell(ByVal CellVal As String) As String
    
    Dim s As String
    Dim Arr As Variant
    Dim ColRange As Collection
    Dim i As Long
    Dim j As Long
    Dim Match As Object
    Dim Matches As Object
    Dim MatchVal As String
    Dim LetterCode As String
    Dim Result As String
    
    ' Remove leading/trailing spaces
    s = Trim(CellVal)
    
    ' Standardize separators
    For i = 0 To Replacements.Count - 1
        s = Replace(s, Replacements.Keys(i), Replacements.Items(i))
    Next i
    
    ' Split on spaces
    Arr = Split(s, " ", -1, vbTextCompare)
    
    ' Extract letter code from first item
    Set Matches = re1.Execute(Arr(0))
    For Each Match In Matches
        MatchVal = Match.Value
        LetterCode = Left(MatchVal, Len(MatchVal) - 1)
    Next Match
'    Debug.Print LetterCode
    
    ' Remove letter codes from array items
    For i = LBound(Arr) To UBound(Arr)
        Arr(i) = Replace(Arr(i), LetterCode, "", 1, -1, vbTextCompare)
    Next i
    
    ' Throw numbers one by one into collection
    Set Numbaz = New Collection
    For i = LBound(Arr) To UBound(Arr)
        If InStr(1, Arr(i), "-", vbTextCompare) > 0 Then
            ' Hyphen found: create range
            Set ColRange = RangeFromNumbers(Arr(i))
            For j = 1 To ColRange.Count
                Numbaz.Add CStr(ColRange(j))
            Next j
        Else
            ' arr item is one number, add it
            Numbaz.Add Arr(i)
        End If
    Next i
    
    ' Concatenate letter codes & numbers
    Result = ""
    For i = 1 To Numbaz.Count
        Result = Result & LetterCode & Numbaz(i) & " "
    Next i
    
    ParseOneCell = RTrim(Result)
    
End Function

Private Function RangeFromNumbers(ByVal NumsString As String) As Collection
    
    Dim NumStart As Long
    Dim NumEnd As Long
    Dim NumStartStr As String
    Dim NumEndStr As String
    Dim i As Long
    Dim TwoNums As Variant
    Dim Result As New Collection
    
    TwoNums = Split(NumsString, "-", -1, vbTextCompare)
    NumStart = TwoNums(0)
    NumEnd = TwoNums(1)
    If NumEnd < NumStart Then
        ' Second number is shortened
        NumStartStr = TwoNums(0)
        NumEndStr = TwoNums(1)
        NumEnd = GetNumEndFromShortened(NumStartStr, NumEndStr)
    End If
    For i = NumStart To NumEnd
        Result.Add i
    Next i
    Set RangeFromNumbers = Result
    
End Function

Private Function GetNumEndFromShortened(ByVal Num1 As String, _
        ByVal Num2 As String) As Long
    
    Dim i As Long
    Dim RevNum1 As String
    Dim RevNum2 As String
    Dim Result As String
    
    RevNum1 = StrReverse(Num1)
    RevNum2 = StrReverse(Num2)
    Result = ""
    
    For i = 1 To Len(RevNum1)
        If i <= Len(RevNum2) Then
            Result = Result & Mid(RevNum2, i, 1)
        Else
            Result = Result & Mid(RevNum1, i, 1)
        End If
    Next i
    
    GetNumEndFromShortened = Val(StrReverse(Result))
    
End Function

Private Sub FillReplacements()
    
    Set Replacements = New Dictionary
    
    With Replacements
        .Add ", ", " "
        ' .Add "; ", " "
    End With
    
End Sub