Excel·VBA单元格摘要备注内容提取

《excel吧提问-单元格摘要备注内容提取》，对单元格备注内容，分别提取姓名和金额

注意：sub中的正则匹配局限性较大，小心使用，且仅支持操作英文括号()内的内容

Private Function RE_STR(source_str As String, pat As String, Optional replace_str As String = "$1")
    '通用正则替换函数，函数定义RE(字符串，正则模式，替换值)对单元格返回正则替换后的字符串
    With CreateObject("vbscript.regexp")  '正则表达式
        .Global = True
        .Pattern = pat
        RE_STR = .Replace(source_str, replace_str)
    End With
End Function

Sub 选中列单元格摘要备注内容提取()
    '对选中区域的单元格，内容按指定分隔符拆分，适用整列选中、单列部分选中、单个单元格选中
    Dim rng As Range, delimiter As String, write_cell, i, j, w, n, write_row
    remark = Array("(", ")")  '备注内容
    delimiter = "、"          '分隔符
    write_cell = "e1"         '写入区域
    write_col = Range(write_cell).Column
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub  '仅支持单列，多列则退出
    
    For Each i In rng
        If InStr(i.Text, remark(0)) > 0 And InStr(i.Text, remark(1)) Then
            str_1 = RE_STR(i.Text, ".*\((.*?)\).*", "$1")
            If InStr(str_1, delimiter) > 0 Then
                arr = Split(str_1, delimiter)
                For j = 0 To UBound(arr)
                    w = RE_STR(CStr(arr(j)), "[^\u4e00-\u9fa5]*", "")
                    n = RE_STR(CStr(arr(j)), "[\u4e00-\u9fa5]*", "")
                    write_row = Range(write_cell).CurrentRegion.Rows.count + 1
                    Cells(write_row, write_col).Resize(1, 2) = Array(w, n)
                Next
            Else
                w = RE_STR(CStr(str_1), "[^\u4e00-\u9fa5]*", "")
                n = RE_STR(CStr(str_1), "[\u4e00-\u9fa5]*", "")
                write_row = Range(write_cell).CurrentRegion.Rows.count + 1
                Cells(write_row, write_col).Resize(1, 2) = Array(w, n)
            End If
        End If
    Next
    
End Sub

举例