Question

Excel VBA编程，通配符，批量替换、筛选所有数字、字母、常见标点符号、中文字符

如图，实际表格中A列有很多行数据，行数可能会变动，格式混乱，请用office2007,VBA编程（附简单解释并使用通配符）实现如下要求：
删除他字符只保留汉字将结果显示在B列，只保留英文结果显示在C列，只保留数字结果显示在D列，只保留标点符号结果显示在E列，各列和A列要对应，例如，C2中结果为"B"。
请测试好后再回答，回答时请用编程框，我好直接无格式复制，程序优秀可再追分。
你好2a()
3B?这个
你是4a*
你好5a.
我想要宏程序，如下图所示。得到程序之后我做一个宏，在一个表内执行一次宏就能得到效果的那种，因为需要在多个表中执行多次该程序，谢谢。





Answer 1

代码如下：(样本文件见附件)

Sub test()
    Dim regX As Object, s As String, i, j
    Set regX = CreateObject("vbscript.regeXP")
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        With regX
            .Global = True
            For j = 2 To 5
                Select Case j
                 Case 2
                    s = "[^\u4e00-\u9fa5]" '取汉字
                Case 3
                    s = "\D" '取数字
                Case 4
                    s = "[^a-zA-Z]" '取字母
                Case 5
                    s = "[\u4e00-\u9fa50-9a-zA-Z]" '取符号
                End Select
                .Pattern = s
                Cells(i, j) = .Replace(Cells(i, 1), "")
            Next j
        End With
    Next
End Sub

追问

非常感谢您的回答，正是我要的答案，顺便问下，那个程序框框是真么弄出来的？

追答

回答问题的时候，有个选择代码语言的地方，选VB就是了。

Answer 2

插入模块，复制粘贴代码。
Function RegExpTest(patrn, strng, Optional ByVal fgf As String = "")
Dim regEx, Match, Matches
Set regEx = CreateObject("vbScript.regexp")
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = True

Set Matches = regEx.Execute(strng)
For Each Match In Matches
RetStr = RetStr & fgf & Match
Next
RegExpTest = Mid(RetStr, Len(fgf) + 1)
End Function
提取文字，B1输入公式=RegExpTest("[一-龥]",$A2)
提取字母，C1输入公式=RegExpTest("[a-zA-Z]",$A2)
提取数字，D1输入公式=RegExpTest("\d",$A2)
提取符号，E1输入公式=RegExpTest("[^a-zA-Z0-9\u4e00-\u9fff\+]",$A2)

追问

我想要宏程序，在一个表内执行一次宏就能得到效果的那种，因为需要在多个表中执行多次该程序。

追答

哦，在自定义函数的基础上追加一个运行代码就可以了。

设置一个按钮，指定RunRET宏

使用方法：选中需要提取的单元格，点击按钮，在选中区域的右侧依次提取出汉字，英文，数字，符号。

Function RegExpTest(patrn, strng, Optional ByVal fgf As String = "")
  Dim regEx, Match, Matches
  Set regEx = CreateObject("vbScript.regexp")
  regEx.Pattern = patrn
  regEx.IgnoreCase = True
  regEx.Global = True
  
  Set Matches = regEx.Execute(strng)
  For Each Match In Matches
    RetStr = RetStr & fgf & Match
  Next
  RegExpTest = Mid(RetStr, Len(fgf) + 1)
End Function
Sub RunRET()
    Dim rng As Range
    For Each rng In Selection
        If Len(rng) > 0 Then
            rng.Offset(, 1).Value = RegExpTest("[一-龥]", rng)
            rng.Offset(, 2).Value = RegExpTest("[a-zA-Z]", rng)
            rng.Offset(, 3).Value = RegExpTest("\d", rng)
            rng.Offset(, 4).Value = RegExpTest("[^a-zA-Z0-9\u4e00-\u9fff\+]", rng)
        End If
    Next rng
End Sub

追问

非常感谢您的回答，客观的说下面的回答者给出的程序最接近我想要的，非常抱歉。

追答

能够解决问题就好，哈哈