如何简化连续编号

aman1516

能解决的自己一个一个解决一下，也算抛砖引玉：
‘带字母数字排除序：

1. Function SortStr(str As String) As String     '
   
2. Dim sr, ar(0 To 10000), r, c, i, j, k     '按数字的最大值，自行修改ar的数组上限
   
3. Dim s As String, ss As String, t
   
4. sr = Split(str, ",")
   
5. For t = 0 To UBound(sr)
   
6.     k = ExtNum(sr(t))
   
7.     If ar(k) = "" Then ar(k) = sr(t) Else ar(k) = ar(k) & "," & sr(t)
   
8. Next
   
9. For j = 0 To UBound(ar)
   
10.     If ar(j) <> "" Then
    
11.        If s = "" Then s = ar(j) Else s = s & "," & ar(j)
    
12.     End If
    
13. Next
    
14. SortStr = s
    
15. End Function
    
16. Sub tt()
    
17. Dim str As String
    
18. 'str = "A9,A29,A30,A32,A10,A19,A3,A7,A8,A15,A18,A20,A28"
    
19. str = "3A,7A,8A,9A,10A,15A,18A,19A,20A,28A,29A,30A,32A"
    
20. Debug.Print SortStr(str)
    
21. End Sub

复制代码

' 全角标点符号转半角标点符号

1. Public Function q2b(t)
   
2.     Dim arr, BRR, i&
   
3.     arr = Split(", \ . ! ? ; : ' ' "" "" [ ] { } ( )")
   
4.     BRR = Split("， 、 。 ！ ？ ； ： ‘ ’ “ ” 【 】 ｛ ｝ （ ）")
   
5.     For i = LBound(BRR) To UBound(BRR)
   
6.         't = Replace(t, ARR(i), BRR(i))
   
7.         t = Replace(t, BRR(i), arr(i))
   
8.     Next i
   
9.     q2b = t
   
10. End Function
    
11. Sub ttt()
    
12. Dim str As String
    
13. str = "QW，ER、TY。UI！OP？AS；DF：GH‘JK’L“ZX”CV【BN】M｛00｝1（99）"
    
14. Debug.Print q2b(str)
    
15. End Sub
    

复制代码

结合 ExtNum 提取数字自定义函数使用

1. Function ExtNum(str As Variant) As Integer    '
   
2.     Dim reg, sr, h As Integer, mh
   
3.     Set reg = CreateObject("vbscript.regexp")
   
4.     reg.Global = True
   
5.     reg.Pattern = "[0-9,.]+"
   
6.     Set sr = reg.Execute(str)
   
7.     For Each mh In sr
   
8.         h = mh
   
9.     Next
   
10.     ExtNum = h
    
11. End Function
    
12. Sub tttt()
    
13. Dim str As String
    
14. str = "44AH"
    
15. Debug.Print ExtNum(str)
    
16. End Sub

复制代码

一个小问题，用到的知识点还不少
再次感谢各位老师！