VBA代码求助
发布网友
共3个回答
热心网友
刚好有过类似的作品
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
热心网友
Function CF(rgs)
Application.Volatile True
Dim arr, brr(), crr, i%, j%, n%, m%, a$, b$, c$, d$, k%
a = rgs
arr = Split(a, ",")
For i = 0 To UBound(arr)
b = arr(i)
For j = 1 To Len(b)
If Mid(b, j, 1) Like "[0-9-]" Then
c = c & Mid(b, j, 1)
Else
d = d & Mid(b, j, 1)
End If
Next j
crr = Split(c, "-")
If InStr(b, "-") Then
d = Left(d, Len(d) / 2)
m = Val(crr(1))
Else
m = Val(crr(0))
End If
For k = Val(crr(0)) To m
ReDim Preserve brr(1 To 1 + n)
brr(n + 1) = d & k
n = n + 1
Next k
d = ""
c = ""
Next i
CF = Join(brr, ",")
End Function
热心网友
有点复杂，
都是 A2那个形式，就稍微简单点
