使用Microsoft Excel VBA提取电话号码

我正在尝试从列A：E中提取电话号码，并将它们放在列F：I中。 “提供的例子是Col E”“的一个实例 。

我希望将电话号码提取到列F：I。 但是，如果一列已经有数据。 然后移动到下一个，使用最后一个“I”列作为最终位置，如果数据有4个数字“永远不会大于4”

Dim c As Range, i As Integer For Each c In Worksheets("data").Range("B2", _ Worksheets("data").Range("B" & Rows.Count).End(xlUp)) With c If .Value2 Like "*???-???-????*" Then For i = 11 To 14 If .Offset(, i).Value2 = "" Then .Offset(, i).Value2 = .Value2 .Value2 = "" GoTo NextC End If Next i End If End With NextC: Next c End sub 

我遇到的问题是它只返回一些电话号码，而不是所有的电话号码。 “98k行”

数据来自我提取的旧XML文件。 在提取的特定“名称”列中，我用一个唯一的符号replace了回车代码，然后我使用那个独特的符号来运行文本到列。 它提供了来自A：N的关键“名称”数据。 {例如：客户姓名，电子邮件地址，手机，家庭电话，项目详细信息，街道地址，城市，邮政编码}}现在每个列都可以保存我想要在4个独立列中提取的电话号码数据“我最喜欢F：我”，但也保留了电话栏填满的逻辑，它不覆盖，并从指定的4我移动到下一个可用的列。

改变If .Value2 Like "*???-???-????*" Then If .text Like "*###-###-####*" Then

成功。

Answer 1

这应该让你开始正则expression式（ 又名正则expression式）解决scheme。

 Option Explicit Sub ewqre() Dim str As String, n As Long, rw As Long Dim rgx As Object, cmat As Object, ws As Worksheet Set rgx = CreateObject("VBScript.RegExp") Set ws = Worksheets("Sheet2") With rgx .Global = True .MultiLine = True 'phone number pattern is: ###-###-#### .Pattern = "[0-9,\-]{12}" For rw = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row str = ws.Cells(rw, "A").Value2 If .Test(str) Then Set cmat = .Execute(str) 'populate the worksheet with the matches For n = 0 To cmat.Count - 1 ws.Cells(rw, Columns.Count).End(xlToLeft).Offset(0, 1) = cmat.Item(n) Next n End If Next rw End With Set rgx = Nothing: Set ws = Nothing End Sub