[已解决]当reg.Pattern = "1\d{10}"遇上混乱的登记时

lingyuncelia1

小灵通:8302143918928509692，肉眼看得出手机号码是：18928509692，
但用reg.Pattern = "1\d{10}"，会变成：
14391892850

如果用reg.Pattern = "189\d{8}"，那如果电话是移动、联通呢，那代码岂不是好长？
有时登记电话的人就是懒到出汁，连个空格都无，连个“、\-()[]”都无。

女189299399660，男13929950449

肉眼看得出女人的手机多了一位数，无效。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-2 16:34

应该可以应付大多数情况了。

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         j = 4
   
6.         For k = 1 To Len(x)    '把所有非数字用","代替
   
7.             If Not IsNumeric(Mid(x, k, 1)) Then Mid(x, k, 1) = ","
   
8.         Next
   
9.         xrr = Split(x, ",")      '以","分离字符串
   
10.         For Each x In xrr
    
11.             Do While Len(x) >= 11      '当字符串长度>=11（表示有可能出现手机号）
    
12.                 xh = Right(x, 11)     '从后往前找
    
13.                 If Left(xh, 1) = "1" Then  '找到一个手机号
    
14.                     j = j + 1
    
15.                     Cells(i, j) = xh
    
16.                     x = Left(x, Len(x) - 11) '长度减11
    
17.                 Else
    
18.                     x = Left(x, Len(x) - 1)   '没找到，长度减1继续找
    
19.                 End If
    
20.                
    
21.                 xq = Left(x, 11)     '从前往后找
    
22.                 If Left(xq, 1) = "1" Then  '找到一个手机号
    
23.                     j = j + 1
    
24.                     Cells(i, j) = xq
    
25.                     x = Mid(x, 12) '长度减11
    
26.                 Else
    
27.                     x = Mid(x, 2)  '没找到，长度减1继续找
    
28.                 End If
    
29.             Loop
    
30.         Next
    
31.     Next
    
32. End Sub

复制代码

跳转到最佳答案楼层

grf1973

应该可以应付大多数情况了。

1. Sub tt()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         j = 4
   
6.         For k = 1 To Len(x)    '把所有非数字用","代替
   
7.             If Not IsNumeric(Mid(x, k, 1)) Then Mid(x, k, 1) = ","
   
8.         Next
   
9.         xrr = Split(x, ",")      '以","分离字符串
   
10.         For Each x In xrr
    
11.             Do While Len(x) >= 11      '当字符串长度>=11（表示有可能出现手机号）
    
12.                 xh = Right(x, 11)     '从后往前找
    
13.                 If Left(xh, 1) = "1" Then  '找到一个手机号
    
14.                     j = j + 1
    
15.                     Cells(i, j) = xh
    
16.                     x = Left(x, Len(x) - 11) '长度减11
    
17.                 Else
    
18.                     x = Left(x, Len(x) - 1)   '没找到，长度减1继续找
    
19.                 End If
    
20.                
    
21.                 xq = Left(x, 11)     '从前往后找
    
22.                 If Left(xq, 1) = "1" Then  '找到一个手机号
    
23.                     j = j + 1
    
24.                     Cells(i, j) = xq
    
25.                     x = Mid(x, 12) '长度减11
    
26.                 Else
    
27.                     x = Mid(x, 2)  '没找到，长度减1继续找
    
28.                 End If
    
29.             Loop
    
30.         Next
    
31.     Next
    
32. End Sub

复制代码

lingyuncelia1

grf1973 发表于 2016-5-2 16:34
应该可以应付大多数情况了。

看上去，我估计也是，应该其他人不会再捣鼓些什么了吧。

datongye

.pattern="1[358]\d{9}"，能解决绝大部分。

datongye

.pattern="1[358]\d{9}(?!\d)"这样可能会把一部分数字超过11位，但可能提取前11位就正确的号码排除在了。

lingyuncelia1

datongye 发表于 2016-5-3 10:28
.pattern="1[358]\d{9}(?!\d)"这样可能会把一部分数字超过11位，但可能提取前11位就正确的号码排除在了。

.pattern="1[358]\d{9}"
这个我是明白的，1在前，358选其中一个，后续9个数字。
.pattern="1[358]\d{9}(?!\d)"
但对于这个，后面多了(?!\d)就不明白是什么回事了？
大侠能否解释下什么意思？

datongye

(?!\d)后面不跟数字即正确

lingyuncelia1

datongye 发表于 2016-5-3 10:28
.pattern="1[358]\d{9}(?!\d)"这样可能会把一部分数字超过11位，但可能提取前11位就正确的号码排除在了。

实验证明，的确可以对付很多情况了，也如你所说，如果是2个手机号码完全贴在一起，的确是给排除了。

datongye

鱼与熊掌不可兼得。最主要是看你数据格式怎样，分类摆放，各自采用不同的方法。这样就可以解决问题了。

datongye

lingyuncelia1 发表于 2016-5-3 17:31
实验证明，的确可以对付很多情况了，也如你所说，如果是2个手机号码完全贴在一起，的确是给排除了。

如果是2个手机号码完全贴在一起，只要最后一个正确，还是可以提取最后一个出来的。好歹还有一个用用。呵呵。