Question

VBA代码纠错，高手求教，很重要啊~~~

我想要将
R0620-R0622,R0625,R1203-R1205
C38011_RF-C38013_RF
C02_WIFI-C05_WIFI
R0645-R0647,R0735-R0739
自动拆分成
R0620,R0621,R0622,R0625,R1203,R1204,R1205
C38011_RF,C38012_RF,C38013_RF
C02_WIFI,C03_WIFI,C04_WIFI,C05_WIFI
R0645,R0646,R0647,R0735,R0736,R0737,R0738,R0739
但是操作时R0645-R0647,R0735-R0739出现了一点问题，下面是我使用的代码，可否请高手帮忙看看是哪里出错了呢？ 或是有更好的程序代码也可以的~~
由於我不是学VB的，可否帮忙在代码边加上注释呢，尤其是循环部份，谢谢！！

代码为
Function CF(rng As Range) As String
Dim a, b()
Dim n1 As Integer, n2 As Integer, p1 As String, p2 As String, nums AS Integer
Dim mp1 As String, mp2 As String, mk As String
a = Split(rng.Value, ",")
For i = 0 To UBound(a)
n1 = 0
n2 = 0
If InStr(a(i), "-") <> 0 Then
p1 = Left(a(i), InStr(a(i), "-") - 1)
p2 = Right(a(i), Len(a(i)) - InStr(a(i), "-"))
For s1 = 1 To Len(p1)
If IsNumeric(Mid(p1, s1, 1)) = True Then nums=nums+1
next s1
For j = 1 To Len(p1)
If Mid(p1, j, 1) Like "[0-9]" Then
If n1 = 0 Then
n1 = j
End If
n2 = n2 + 1
End If
Next j
mp1 = Left(p1, n1 - 1)
num1 = Val(Mid(p1, n1, n2))
If Len(p1) - n1 - n2 + 1 <> 0 Then
mp2 = Right(p1, Len(p1) - n1 - n2 + 1)
Else
mp2 = ""
End If
For j = 1 To Len(p2)
If Mid(p2, j, 1) Like "[0-9]" Then
If n1 = 0 Then
n1 = j
End If
n2 = n2 + 1
End If
Next j
num2 = Val(Mid(p2, n1, n2))
l= num1
ReDim b(num2 - num1)
For k = num1 To num2
If Len(k) < n2 Then
mk = k
For m = 1 To n2- Len(k)-nums
mk = "0" & mk
Next m
End If
b(k - l) = mp1 & mk & mp2
Next k
a(i) = Join(b, ",")
End If
Next i
CF = Join(a, ",")
End Function

Answer 1

'一个太复杂的过程最好不要写那么长，那样除了要定义大量变量不说，还需要循环套循环，条件语句套条件语句，那样不太好，容易出错而且代码不简洁。
'像这个拆分为多个过程写比较好，看起来简洁，查错也容易。
'函数还是命名为你那个吧-CF，我只不过把里面的内容拆成3个独立的函数，使用的时候还是那样,如：单元格B1=CF(A1)
'这段代码只适用于你给出的几个格式示例，如果其他情况则要具体对待，代码中对应位置有具体说明

Function CF(rng As Range) As String
Dim a() As String, I As Integer
a = Split(rng.Value, ",")
'把长字符串根据逗号拆分到数组，然后一个个的用CHF函数来细细拆分
For I = 0 To UBound(a)
If CF = "" Then
CF = ChF(a(I))
Else
CF = CF & "," & ChF(a(I))
End If
Next I
End Function

'下面的CHF函数是用来细拆，类似C38011_RF-C38013_RF这样的字串
Function ChF(S As String) As String
Dim P1 As String, P2 As String
If InStr(S, "-") = 0 Then
ChF = S
Else
'P1,P2是拆开区间的起始和终止范围
P1 = Left(S, InStr(S, "-") - 1)
P2 = Right(S, Len(S) - InStr(S, "-"))
ChF = QuJ(P1, P2)
End If
End Function

'下面的QUJ函数是用来根据区间的起始和终止范围生成连序号的字符串
Function QuJ(S1 As String, S2 As String) As String
Dim N1 As Integer, N2 As Integer
Dim LS As String, RS As String, NUM1 As String, NUM2 As String
Dim I As Long

'N1和N2分别是字串中第一个数字和最后一个数字的位置
'这里注意字符串中的数字必须是在一起的，如果是类似RF012_12F的情况则不适用该代码
For I = 1 To Len(S1)
If IsNumeric(Mid(S1, I, 1)) = True Then
If N1 = 0 Then N1 = I
N2 = I
End If
Next I

'LS和RS分别是字串中数字串左侧和右侧的剩余字符
'NUM1和NUM2则是数字发生变化的范围
'这里注意你的区间前后长度和格式都必须一致，类似RF12-R123F的情况则不好处理
LS = Left(S1, N1 - 1)
RS = Right(S1, Len(S1) - N2)
NUM1 = Mid(S1, N1, N2 - N1 + 1)
NUM2 = Mid(S2, N1, N2 - N1 + 1)

'生成连续序号的字符串
For I = Val(NUM1) To Val(NUM2)
If QuJ = "" Then
QuJ = LS & Format(I, String(Len(NUM1), "0")) & RS
Else
QuJ = QuJ & "," & LS & Format(I, String(Len(NUM1), "0")) & RS
End If
Next I
End Function

另外看了一下你的代码，具体问题出在哪我没去找，但是看了一下思路，有些代码完全可以不用，比如对区间的P1,P2两次求数字的起始位置N1,N2，其实只要一次就可，因为你的格式前后都是一样的，否则即使你两次分别求算了，代码还是不能用。

追问

感谢~~
我希望可以用一个公式直接拉就搞定的那种，你的操作起来不太实用~~

追答

我的本身就是一个公式啊，只不过代码我拆分为几段代码而已。使用时你还是只要在B1单元格里输入=CF(a1)就可以了

Answer 2

你找的那程序太臃肿 凌乱,看这不舒服,我重新帮你写了个. 重点部分都加了注释 该函数只作用于单个单元格,能处理任何长度的前后缀字符串,但数字部分必须是连续的,另外单元格的字符串中不能包含"%" 你和你的那段程序 比较一下
Function CF(rng As String) As String
Dim MyAllarr, Overarr
Dim CFarr
Dim nStr, Lnum, Unum, Tabc As String

MyAllarr = Split(rng, ",")
For n1 = LBound(MyAllarr) To UBound(MyAllarr)
If InStr(MyAllarr(n1), "-") Then '拆分含开头和结尾的字符串
CFarr = Split(MyAllarr(n1), "-") '把开头和结尾分别写入数组
Lnum = QuShu(CFarr(0)) '用子函数获取开头部分的数字段
Unum = QuShu(CFarr(1)) '用子函数获取结尾部分的数字段
Tabc = Replace(CFarr(0), Lnum, "%") '获取除去数字段的其他部分,开头和结尾用"%"分隔
If Overarr = "" Then '从这里开始就是写入拆分过的字符串了
Overarr = CFarr(0) '
Else
Overarr = Overarr & "," & CFarr(0)
End If
For n2 = 1 To Unum - Lnum '处理含开头和结尾的元素
If InStr(Tabc, "%") = Len(Tabc) Then
Overarr = Overarr & "," & Left(Tabc, Len(Tabc) - 1) & Format(Lnum + n2, String(Len(Lnum), "0"))
Else
Overarr = Overarr & "," & Left(Tabc, InStr(Tabc, "%") - 1) & Format(Lnum + n2, String(Len(Lnum), "0")) & Right(Tabc, Len(Tabc) - InStr(Tabc, "%"))
End If
Next
Else
If Overarr = "" Then
Overarr = MyAllarr(n1)
Else
Overarr = Overarr & "," & MyAllarr(n1)
End If
End If
Next
CF = Overarr
End Function
Function QuShu(TempStr As Variant) '获取字符串中数字的子函数
Dim i As Integer
Dim Bol As Boolean
For i = 1 To Len(TempStr)
s = Mid(TempStr, i, 1)
Bol = s Like "#"
If Bol Then QuShu = QuShu & s
Next
End Function

追问

谢谢你，不过我的包含没有连字符的部份~~

追答

没看懂你说的意思.
是不是说我说的单元格的字符串中不能包含"%"这个?
因为我的代码中
Tabc = Replace(CFarr(0), Lnum, "%")
用到"%" 处理前缀和后缀.所以如果单元格中的字符串中如果包含有"%" 就不能正确的处理前后缀,
你可以修改为你用不到的符号,就可以了.

Answer 3

找到原因了。
只要加一句就好了。
Function CF(rng As Range) As String
Dim a, b()
Dim n1 As Integer, n2 As Integer, p1 As String, p2 As String, nums AS Integer
Dim mp1 As String, mp2 As String, mk As String
a = Split(rng.Value, ",")
For i = 0 To UBound(a)
n1 = 0
n2 = 0
nums=0 '就加了这一句。
If InStr(a(i), "-") <> 0 Then
p1 = Left(a(i), InStr(a(i), "-") - 1)
p2 = Right(a(i), Len(a(i)) - InStr(a(i), "-"))
For s1 = 1 To Len(p1)
If IsNumeric(Mid(p1, s1, 1)) = True Then nums=nums+1
next s1
For j = 1 To Len(p1)
If Mid(p1, j, 1) Like "[0-9]" Then
If n1 = 0 Then
n1 = j
End If
n2 = n2 + 1
End If
Next j
mp1 = Left(p1, n1 - 1)
num1 = Val(Mid(p1, n1, n2))
If Len(p1) - n1 - n2 + 1 <> 0 Then
mp2 = Right(p1, Len(p1) - n1 - n2 + 1)
Else
mp2 = ""
End If
For j = 1 To Len(p2)
If Mid(p2, j, 1) Like "[0-9]" Then
If n1 = 0 Then
n1 = j
End If
n2 = n2 + 1
End If
Next j
num2 = Val(Mid(p2, n1, n2))
l= num1
ReDim b(num2 - num1)
For k = num1 To num2
If Len(k) < n2 Then
mk = k
For m = 1 To n2- Len(k)-nums
mk = "0" & mk
Next m
End If
b(k - l) = mp1 & mk & mp2
Next k
a(i) = Join(b, ",")
End If
Next i
CF = Join(a, ",")
End Function

追问

哈~ 谢谢~~
我自己也弄了下，截去了计算数字长度的部份再稍改下已经ok了~~
不过你可以帮忙在代码边加点注释吗（尽量详细点）？
因为我学C++，VB看起来有点模棱两可的~~
谢谢啦~~