提取字母中间字符串和倒数第一个字符

zongheng20114

提取字母中间字符串和倒数第一个字符

rtian

1. Sub rtian()
   
2. s = [a5]
   
3. For i = Len(s) To 1 Step -1
   
4.     If Not (IsNumeric(Mid(s, i, 1))) Then
   
5.         [e5] = Mid(s, i, 1)
   
6.         n = i
   
7.         Exit For
   
8.     End If
   
9. Next
   
10.     [d5] = Mid(s, 4, n - 4)
    
11. End Sub
    

复制代码

bajifeng

1. Sub bb()    'bajifeng
   
2. For i = 5 To [a65536].End(3).Row
   
3.     Set reg = CreateObject("vbscript.regexp")
   
4.     With reg
   
5.         .Global = True
   
6.         .IgnoreCase = True
   
7.         .MultiLine = False
   
8.         .Pattern = "/(\w+)(?:.)?([A-Z])\d+"
   
9.     End With
   
10.     For Each m In reg.Execute(Cells(i, 1))
    
11.         j = 1
    
12.         For Each sm In m.SubMatches
    
13.             j = j + 1
    
14.             Cells(i, j) = sm
    
15.         Next
    
16.     Next
    
17. Next
    
18. End Sub

复制代码

bajifeng

>>>>>>>>>>>>>>>>

zax010

Sub zz()
    ar = [a4].CurrentRegion
    For i = 2 To UBound(ar)
        s = Split(ar(i, 1), "/")(1)
        For a = Len(s) To 1 Step -1
            If IsNumeric(Mid(s, a, 1)) = False Then
                ar(i, 3) = Mid(s, a, 1)
                k = Mid(s, 1, a - 1)
                If Right(k, 1) = "+" Then k = Mid(k, 1, Len(k) - 1)
                ar(i, 2) = k
                Exit For
            End If
        Next
    Next
    [a4].CurrentRegion = ar
End Sub

zax010

>>>>>>>>>>>>>>>>


提取字母中间字符串和倒数第一个字符.rar (9.61 KB, 下载次数: 12)

2016-5-30 20:25 上传

点击文件名下载附件

crozy

条条大路通罗马

Sub aa()
    Dim arr
    arr = Range("a4").CurrentRegion
    For i = 2 To UBound(arr)
        s = Replace(Split(arr(i, 1), "/")(1), "+", "")
        For j = Len(s) To 1 Step -1
            x = Mid(s, j, 1)
            If Asc(UCase(x)) >= 65 And Asc(UCase(x)) <= 90 Then Exit For
        Next
        arr(i, 3) = Mid(s, j, 1)
        arr(i, 2) = Mid(s, 1, j - 1)
        [b4].Resize(UBound(arr)) = Application.Index(arr, , 2)
        [c4].Resize(UBound(arr)) = Application.Index(arr, , 3)
    Next
End Sub

zongheng20114

zax010 发表于 2016-5-30 20:25
>>>>>>>>>>>>>>>>

谢谢您，您的方法可行

zongheng20114

crozy 发表于 2016-5-30 23:35
条条大路通罗马

Sub aa()

谢谢您，您的方法可行

zongheng20114

bajifeng 发表于 2016-5-30 18:20
>>>>>>>>>>>>>>>>

谢谢您，您的方法可行