使用 Microsoft Excel VBA 提取电话号码

Question

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

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