使用Microsoft Excel VBA提取电话号码

Question

我正在尝试从列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文件。在提取的特定“名称”列中，我用唯一符号替换了回车代码，然后我使用该唯一符号将文本运行到列。它提供了来自A：N的关键“名称”数据。 {示例：客户姓名，电子邮件地址，手机，家庭电话，项目详细信息，街道地址，城市，邮政...}现在，这些列中的每一列都可以很好地保存我想要在4个单独的列中提取的电话号码数据“最喜欢F：I”，但也保持逻辑，当电话栏填满时，它不会覆盖并转移到我指定的4个下一个可用列。

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

成功。

Answer 1

这应该让你开始使用正则表达式（ aka regex）解决方案。

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