删除excel中的手机号码（二）

脚本需求说明

有一excel文件从某crm系统导出，某目标列中含有有效文字+客户手机号码（手机号码个数可能有多个，位置不定，中间可能有,.\等分隔符分隔），现考虑隐私要求删除手机号码（及无用分隔符空白符等）。数据行数在2000行左右。

实现思路

仍然是正则表达式匹配11位手机号，但这次不用python了，直接用excel的vba来完成，无需任何第三方环境。之前都没学过vba,边查资料边写出来了。

代码

Private Declare Function MessageBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As Long, ByVal dwTimeout As Long) As Long

Sub main()
    Dim C, X, Y
    MsgBox2 ("开始删除...")
    C = getCell()
    X = C(0)
    Y = C(1)
    Call process(X, Y)
    MsgBox ("已删除完成，请确认后保存！")
End Sub

'在当前活动工作簿的第一张sheet的前两行找到“投诉内容”的单元格
'返回值为数组：[0]为行，[1]为列
Function getCell()
    For Each cell In ActiveWorkbook.Worksheets(1).Range("a1:az2")
        If cell.Value = "投诉内容" Then getCell = Array(cell.Row, cell.Column): Exit For
    Next
End Function

' 后期绑定vb正则对象，调用replace()方法把手机号去掉
Function process(X, Y)
    Dim re, lastRow
    lastRow = Cells(Rows.Count, Y).End(xlUp).Row   '最后非空一行
    Set re = CreateObject("VBscript.RegExp")
    re.Global = True
    re.Pattern = "1[3-9]\d{9}[,，.。/、\\]?"   '手机号，及后面可能出现的一个字符
    For Each cell In ActiveWorkbook.Worksheets(1).Range(Cells(X + 1, Y), Cells(lastRow, Y))  '下一行开始处理到最后一行
        cell.Value = re.Replace(Replace(Trim(cell), vbCrLf, ""), "") '先去空，再去回车，再去re去手机号，最后设置cell的值
    Next
End Function

'1000以毫秒作为单位
Sub MsgBox2(str)
   MessageBoxTimeout 0, str, "", 0, 0, 1000
End Sub

应用

可以把此段vba另存为.xlam的加载宏文件，放在C:\Users\用户名\AppData\Roaming\Microsoft\AddIns 目录下，excel启用这个加载宏，并可以把它自定义到 快速访问工具栏，这样每次打开文档都会加载这段vba,并可以直接使用。