求关于“页码范围”的函数

Peter_Chow

在Office Word的打印页面中，有一个“页面范围 → 页码范围：请键入页码和/或用逗号分隔的页码范围(例如: 1.3.5-12)。”
请问在Excel VBA中，有没有这样一个函数或方法——输入1.3.5-12后，得到一个数组包含元素1,3,5,6,7,8,9,10,11,12。
如果没有的话，就要自己写了。

Peter_Chow

看来这个功能大家用的少，可有可无，不怎么关注。
现在只好自己做一个这样的函数了。
代码如下，分享给大家，请点评！

1. Public Function NumArr(ByVal NumStr As String) As Variant
   
2.     '使用此函数前，应提示或说明使用方法、要求；
   
3.     '功能：输入字符串"1,3,5-8"，输出数组Array(1,3,5,6,7,8)
   
4.     '参数格式：用正整数、逗号、减号组成的字符串，不含其它字符；
   
5.     '1≤整数≤1048576，逗号(,)表示分隔，减号(-)表示整数连续。
   
6.     Dim i As Long, j As Long, L As Long, R As Long, V As Variant
   
7.     NumStr = Replace(Replace(Replace(NumStr, vbCr, ""), vbLf, ""), "　", "")
   
8.     NumStr = Replace(Replace(Replace(NumStr, "，", ","), "－", "-"), " ", "")
   
9.     For i = 1 To Len(NumStr)
   
10.         If Mid(NumStr, i, 2) = ",," Then Mid(NumStr, i, 2) = " ,"
    
11.         If Mid(NumStr, i, 2) = "--" Then Mid(NumStr, i, 2) = " -"
    
12.     Next i: NumStr = Replace(NumStr, " ", "")
    
13.     If Left(NumStr, 1) = "," Or Left(NumStr, 1) = "-" Then NumStr = Right(NumStr, Len(NumStr) - 1)
    
14.     If Right(NumStr, 1) = "," Or Right(NumStr, 1) = "-" Then NumStr = Left(NumStr, Len(NumStr) - 1)
    
15.     NumArr = Array(0): If NumStr = "" Then Exit Function
    
16.     V = Split(Replace(NumStr, "-", ","), ",")
    
17.     For i = LBound(V) To UBound(V)
    
18.         If IsNumeric(V(i)) Then
    
19.             If V(i) < 1 Or V(i) > 1048576 Then MsgBox "转换的数字超出限制范围！": Exit Function
    
20.             If CLng(V(i)) <> CDbl(V(i)) Then MsgBox "转换的数字含有小数！": Exit Function
    
21.         Else: MsgBox "转换的数字不合规范！": Exit Function
    
22.     End If: Next i: V = Split(NumStr, ","): NumStr = ""
    
23.     For i = LBound(V) To UBound(V)
    
24.         If IsNumeric(V(i)) Then
    
25.             NumStr = NumStr & V(i) & ","
    
26.         Else: L = InStr(V(i), "-"): R = Len(V(i))
    
27.             If L > 1 And L < R And Len(Replace(V(i), "-", "")) = R - 1 Then
    
28.                 R = CLng(Right(V(i), R - L)): L = CLng(Left(V(i), L - 1))
    
29.                 If L > R Then j = L: L = R: R = j   '在Ｌ变动前先Ｒ赋值
    
30.                 For j = L To R: NumStr = NumStr & j & ",": Next j
    
31.             Else: MsgBox "输入的字符串不合规范！": Exit Function
    
32.     End If: End If: Next i: NumArr = Split(Left(NumStr, Len(NumStr) - 1), ",")
    
33. End Function
    

复制代码

开始以为这个函数的代码很简单，可在做的过程中发现也不简单。
主要问题是：无法规范输入的字符串。
当任意的字符串进来后，就要对其进行规整、判断。
函数的大部分代码（约3/4）都是在处理这个问题。

Peter_Chow

2楼的代码是用VBA字符处理函数做的，感觉代码太多，想简化。
正好学了正则表达式，也做了一个，代码少了40%以上。

1. Public Function NumArr2(ByVal NumStr As String) As Variant
   
2.     Dim i As Long, j As Long, L As Long, R As Long
   
3.     Dim s As String, Reg As Object, Mh As Object
   
4.     NumStr = Replace(Replace(NumStr, "，", ","), "－", "-") & ","
   
5.     Set Reg = CreateObject("VBScript.RegExp"): NumArr2 = Array(0)
   
6.     With Reg: .Global = True: .IgnoreCase = True
   
7.         .Pattern = "\s": NumStr = .Replace(NumStr, "")
   
8.         .Pattern = "-+": NumStr = .Replace(NumStr, "-")
   
9.         .Pattern = "([1-9]\d*-)?[1-9]\d*," '([1-9]\d{0,6}-)?[1-9]\d{0,6},
   
10.         Set Mh = .Execute(NumStr): If Mh.Count = 0 Then Exit Function
    
11.     End With: NumStr = ""
    
12.     For i = 0 To Mh.Count - 1: s = Mh(i).Value
    
13.         If InStr(s, "-") = 0 Then
    
14.             NumStr = NumStr & s
    
15.         Else: L = InStr(s, "-") + 1: R = Len(s)
    
16.             R = CLng(Mid(s, L, R - L)): L = CLng(Left(s, L - 2))
    
17.             If L > R Then j = L: L = R: R = j
    
18.             For j = L To R: NumStr = NumStr & j & ",": Next j
    
19.     End If: Next i: NumArr2 = Split(Left(NumStr, Len(NumStr) - 1), ",")
    
20. End Function

复制代码

2楼、3楼的函数功能一样，但也略有不同(对字符串的处理方法不同)，各有千秋。
用正则表达式，感觉在用大炮打鸟、牛刀杀鸡。
我还是喜欢2楼的代码，好像还可以输入全角数字。

Peter_Chow

昨天无意中发现IsNumeric()函数可以判断全角数字。