Function 展開字符序號(ra As Range) As String
'Dim ra As String
'ra = "A1-A2,A4,A5,A9-A12,B15,B8-B13"
Dim Txt As String, Tt As String
Dim Lengthtxt As Long
Dim i As Long, j As Long, No As Long
Dim reTxt As String
Dim arTx As Variant, oTxt() As String
'把文字按分隔符分開，如果沒有文字則退出,有則存到otxt數組
reTxt = ""
arTx = Split(ra.Text, ",")
If UBound(arTx) < 0 Then Exit Function
ReDim oTxt(UBound(arTx))
oTxt = arTx
'For i = 0 To UBound(arTx)
'oTxt(i) = arTx(i)
'Next i
'循環數組otxt對比每段文字是否帶有連接符"-"
For j = 0 To UBound(oTxt)
'Debug.Print oTxt(j)
arTx = Split(oTxt(j), "-")
'連接符前的起始編號可以直接加入返回字符串retxt
reTxt = reTxt & arTx(0) & ","
'如果-連接符後的字符還有則進行循環加入中間編號直至與末尾編號相等
'首先需檢查編號的頭字符是否壹致
If UBound(arTx) > 0 Then
Lengthtxt = Len(oTxt(j))
'取起始號字符代號為txt
Txt = ""
For i = 1 To Lengthtxt
Tt = Mid(arTx(0), i, 1)
Select Case Asc(Tt)
Case Asc("a") To Asc("z"), Asc("A") To Asc("Z")
Txt = Txt & Tt
Case Asc("0") To Asc("9")
Exit For
End Select
Next i
'檢查結尾編號的字符代號與起始壹致則循環添加中間編號到返回字符串
If left(arTx(1), Len(Txt)) = Txt Then
No = Val(Replace(arTx(0), Txt, ""))
Do
No = No + 1
Tt = Txt & No
If Tt <> "" Then reTxt = reTxt & Tt & ","
Loop Until Tt = arTx(1)
End If
End If
Next j
'輸出返回的字符串
'Debug.Print reTxt
If right(reTxt, 1) = "," Then reTxt = left(reTxt, Len(reTxt) - 1)
展開字符序號 = reTxt
End Function