如何用vba实现“连续的数字用 — 代替”？

pipiludaxian

中國　１，２，３，４，５，８，１２

美國　１，３，４，５，６，９

如何用vba實現如下效果？

中國　１－５，８，１２

美國　１，３－６，９

zhanglei1371

仅仅针对题目有效，具体情况自己修改：
Sub sdf()
    Selection.HomeKey wdStory
    With Selection.Find
        .Text = "[０１２３４５６７８９0-9]@[, ，]@[０１２３４５６７８９0-9]{1,}"
        .MatchWildcards = 1
        Do While .Execute
            p = Replace(.Parent, "，", ", ")
            a0 = Split(p, ", ")(0)
            b0 = Split(p, ", ")(1)
            a = StrConv(Split(p, ", ")(0), vbNarrow) '全角转半角
            b = StrConv(Split(p, ", ")(1), vbNarrow)
            If sta = "" Then sta = a0
            If a + 1 = Val(b) Then
                .Parent.Start = .Parent.End - Len(b)
                i = i + 1
                Selection.Collapse 1
            Else
                If i < 1 Then sta = "": .Parent.End = .Parent.End - 2: .Parent.Collapse 0: GoTo aa:
                en = a0
                Selection.HomeKey
                Debug.Print sta & "[!^13]@" & en
                Selection.Find.Execute sta & "[!^13]@" & en, , , 2, , , , , , sta & "-" & en, 1
                Selection.Collapse 0
                .Text = "[０１２３４５６７８９0-9]@[, ，]@[０１２３４５６７８９0-9]{1,}"
                sta = ""
                i = 0
            End If
aa:
        Loop
    End With
End Sub

loquat

1. Function myJoinNum(ByVal str$, ByVal splitChar$) As String
   
2. Dim aLen&, i&, arr() As String
   
3. arr = Split(str, splitChar)
   
4. aLen = UBound(arr)
   
5. myJoinNum = arr(0)
   
6. For i = 1 To aLen
   
7.     If 1 * arr(i) = 1 * arr(i - 1) + 1 Then
   
8.         Do While 1 * arr(i) = 1 * arr(i - 1) + 1
   
9.             i = i + 1
   
10.         Loop
    
11.         myJoinNum = myJoinNum & "-" & arr(i - 1) & splitChar & arr(i)
    
12.     Else
    
13.         myJoinNum = myJoinNum & splitChar & arr(i)
    
14.     End If
    
15. Next i
    
16. End Function

复制代码

作为参考，求高手简化。
总感觉还可以简化。

loquat

这个比上述代码效率稍低一些，仅供交流。

1. Function myJoinNum_MeThee(ByVal str$, ByVal splitChar$) As String
   
2. '参数1：待处理的字符串
   
3. '参数2：字符串中间的分隔符
   
4. Dim aLen&, i&, arr() As String
   
5. Dim aIndex&, bIndex&
   
6. arr = Split(str, splitChar)
   
7. aLen = UBound(arr)
   
8. myJoinNum_MeThee = arr(0)
   
9. For i = 1 To aLen
   
10.     If 1 * arr(i) = 1 * arr(i - 1) + 1 Then
    
11.         aIndex = InStrRev(myJoinNum_MeThee, "-")  '逆向查找“-”
    
12.         bIndex = InStrRev(myJoinNum_MeThee, splitChar) '逆向查找splitChar
    
13.         aTemp = Mid(myJoinNum_MeThee, InStrRev(myJoinNum_MeThee, "-") + 1)  '取“-”之后的部分
    
14.         If aIndex > bIndex And IsNumeric(aTemp) Then   '如果有“-”存在 且“-”之后的部分只有数字
    
15.             myJoinNum_MeThee = Left(myJoinNum_MeThee, aIndex - 1) & "-" & arr(i)
    
16.         Else
    
17.             myJoinNum_MeThee = myJoinNum_MeThee & "-" & arr(i)
    
18.         End If
    
19.     Else
    
20.         myJoinNum_MeThee = myJoinNum_MeThee & splitChar & arr(i)
    
21.     End If
    
22. Next i
    
23. End Function

复制代码