从excel表格一列混合文字的数据中找出手机号码并复制生成新的一列
现有一个excel表格中，其中一列的每个单元格都有大量文字包括一些手机号码，文字和手机是混杂的，手机号有的不止一个，而且有日期等，我现在想要找到这些手机号码并复制到后面生成新的一列中，函数怎样写？写完之后怎样运行？谢谢之前用
B1
=-LOOKUP(,-MID(A1,ROW(INDIRECT("$1:$"&LENB(A1))),11))
函数，部分可以，但有时会有一些奇怪数字出现，且如果有两个以上的手机号码不能实现
我试着做了一个 你看看 比如A1是那些文字
B1输入 =LARGE(IF(ISERROR(-MID($A1,ROW(1:100),11)),0,IF(--MID($A1,ROW(1:100),11)>10000000000,--MID($A1,ROW(1:100),11),0)),1)
输入完成后摁住 ctrl+shift+回车结束输入(!!!!!这是个数组公式,三键确认很重要,直接回车结果不正确)
在c1的公式和这个差不多,但是需要把最后的那个1改成2 因为b1里只显示了最大的那个 这个改成2可以显示第二大的那个 要是你的一个单元格里有三四个手机号 以此类推
另外,如果那文字说明超过100字 那把1:100改大点
注意: 我的公式有修改 原来的情况如果最后几个是数字的话 也会出现一些不是电话号码的小数字 我现在加了一个判断必须大于 10000000000 的条件
我这个图里最后用的column()函数代替1或者2 我怕你不会用,那就自己写比较好
追问哥们，有的结果成了0
Sub RegExpText()
Dim regExp As Object
Dim Text1 As String, Text2 As String
c = 10 '此数字改为“事情”所在的列数
Set regExp = CreateObject("VBScript.RegExp")
regExp.Pattern = "[1]\d{10}"
regExp.Global = True
For i = 1 To Cells(65536, c).End(xlUp).Row
Text1 = Cells(i, c).Value
Text2 = ""
Set a = regExp.Execute(Text1)
If a.Count > 0 Then
For Each b In a
Text2 = Text2 & b.Value & Chr(10)
Next
Cells(i, c + 1) = Left(Text2, Len(Text2) - 1)
End If
Next
End Sub追问
怎样运行正则表达式
追答1、打开工作表，按Alt+F11，打开VBA编辑器
2、“插入”－“模块”
3、把代码复制到“模块1”里
4、工作表里，按Alt+F8，运行宏“RegExpText”
c 未定义
把最上面option一行删除
追问你太厉害了！！！但是还有一点是如果有一串数字超过11位，且里面含有1开头的，程序就会把这个数字也默认成为手机号码
追答要么把所有的数字串都取出来，再判断长度＝11：
Sub RegExpText()
Dim regExp As Object
Dim Text1 As String, Text2 As String
c = 1 '此数字改为“事情”所在的列数
Set regExp = CreateObject("VBScript.RegExp")
regExp.Pattern = "[1]\d*"
regExp.Global = True
For i = 1 To Cells(65536, c).End(xlUp).Row
Text1 = Cells(i, c).Value
Text2 = ""
Set a = regExp.Execute(Text1)
If a.Count > 0 Then
For Each b In a
If Len(b.Value) = 11 Then Text2 = Text2 & b.Value & Chr(10)
Next
If Len(Text2) > 1 Then Cells(i, c + 1) = Left(Text2, Len(Text2) - 1)
End If
Next
End Sub
