Function 小爪提取汉字(s_string)
'--------------
'例如：GGGHA和，提取“和”
'--------------------
      For i = 1 To Len(s_string)
         If Mid(s_string, i, 1) Like "[!A-Z !a-z ]" And Mid(s_string, i, 1) Like "[!0-9]" Then
         小爪提取汉字 = 小爪提取汉字 & Mid(s_string, i, 1)
         End If
      Next i
End Function

*****************

Function quhz(s_string)
'--------------
'例如：☆晓星☆(6169628)，提取“晓星”
'--------------------
      For i = 1 To Len(s_string)
         If Mid(s_string, i, 1) > "吖" Then
         quhz = quhz & Mid(s_string, i, 1)
         End If
      Next i
End Function

----------------------------------------------------------------

Function 小爪提取英文字(s_string)
'--------------
'例如：GGGHA和，提取“GGGHA”
'--------------------
      For i = 1 To Len(s_string)
         If Mid(s_string, i, 1) Like "[A-Z a-z ]" Then
       
         小爪提取英文字 = 小爪提取英文字 & Mid(s_string, i, 1)
         End If
      Next i
End Function

-------------------------------------------------------------------------

Function 小爪提取数字(s_string)
'--------------
'例如：GGG3.6和，提取“3.6” 点的char＝46
'--------------------
      For i = 1 To Len(s_string)
          If IsNumeric(Mid(s_string, i, 1)) Or Asc(Mid(s_string, i, 1)) = 46 Then
          小爪提取数字 = 小爪提取数字 & Mid(s_string, i, 1)
         
         End If
      Next i
End Function

----------------------------------------------------------------------

★☆ (928128163)提的问题2009-10-19 19：13

Function XZTQSY(s_string) '小爪提取数字和运算符 运算符间添加"+"
If s_string = "" Then
XZTQSY = "单元格为空"
Exit Function
End If

'--------------------
On Error GoTo 100
      For I = 1 To Len(s_string)
          If IsNumeric(Mid(s_string, I, 1)) Or (Asc(Mid(s_string, I, 1)) > 39 _
          And Asc(Mid(s_string, I, 1)) < 48 And Asc(Mid(s_string, I, 1)) <> 44) Then
          XZTQSY = XZTQSY & Mid(s_string, I, 1)
          ElseIf I > 1 And Len(XZTQSY) > 0 Then
            If Right(XZTQSY, 1) <> "+" Then
             XZTQSY = XZTQSY & "+"
            End If
          End If
      Next I
      If Right(XZTQSY, 1) = "+" Then
      XZTQSY = Mid(XZTQSY, 1, Len(XZTQSY) - 1)
      End If
      XZTQSY = Evaluate(XZTQSY)
100:
End Function

----------------------

.'【转老猫的原创】一个取中文，取英文，取数字,取特殊字符的VBA自定义函数
'
'参数/意义
'0: 取数字
'1: 取中文
'2: 取英文
'3: 取特别字符
'4.取第一个数字的位置
'5.取最后一个数字的位置
Function MyGet(Srg As String, Optional n As Integer = 0)
    Dim i As Integer
    Dim s, MyString(1 To 3) As String
    Dim st As Integer, en As Integer
    Dim Bol As Boolean
    
    Bol = True
    For i = 1 To Len(Srg)
        s = Mid(Srg, i, 1)
        If s Like "#" Then
        MyString(1) = MyString(1) & s
            If Bol Then
                st = i: Bol = False
                Else
                en = i
            End If
        End If
        If Asc(s) < 0 Then MyString(2) = MyString(2) & s
        If s Like "[a-z,A-Z]" Then MyString(3) = MyString(3) & s
    Next
        Select Case n
           Case 0 'Numbers
             MyGet = Val(MyString(1))
           Case 1 'Chinese
             MyGet = MyString(2)
           Case 2 'Strings
             MyGet = MyString(3)
           Case 3 'Special Strings
           MyGet = Srg
                For Each s In MyString()
                   For i = 1 To Len(s)
                      MyGet = Replace(MyGet, Mid(s, i, 1), "")
                   Next i
                Next s
           Case 4 'first number address
           MyGet = st
           Case 5 'last number address
           MyGet = en
        End Select
End Function

**********************

Function 汉字(reg, Optional gb As Boolean = True) As String
            
With CreateObject("VBSCRIPT.REGEXP")
    .Global = True
    If gb Then
        .Pattern = "[^\u4e00-\u9fa5]"
    Else
        .Pattern = "[\u4e00-\u9fa5]"
    End If
    汉字 = .Replace(reg, "")
End With
End Function
 '功能：提取给定字符串(单元格)中汉字与非汉字集  说明：reg  原字符串或单元格   gb   当为True时，提取汉字（默认），否则提取非汉字。
             '可以同时使用自定义函数形式提取亦可以使用VBA批量提取 公式：=Fonts(A1) 或公式：=Fonts(A1,1) 仅提取A1里的汉字 公式：=Fonts(A1,0) 仅提取A1单元格的非汉字

---------------------------------------------------------------

Function 取值(rng, types As String) As String    
    Dim obj As Object
    Set obj = CreateObject("VBSCRIPT.REGEXP")
    With obj
        .Global = True
        If types = "-hz" Then  '去汉字
            .Pattern = "[一-﨩]"
        ElseIf types = "-zm" Then  '去字母
            .Pattern = "[a-zA-Z]"
        ElseIf types = "-sz" Then  '去数字
            .Pattern = "\d"
        ElseIf types = "+hz" Then  '取汉字
            .Pattern = "[^一-﨩]"
        ElseIf types = "+zm" Then    '取字母
            .Pattern = "[^a-zA-Z]"
        ElseIf types = "+sz" Then    '取数字
            .Pattern = "[^0-9]"
        End If
        取值 = .Replace(rng, "")
    End With
End Function