使用Microsoft Excel VBA提取電話號碼

Question

我正在嘗試從A：E列中提取電話號碼，並將其放在F：I列中。 “提供的示例是Col” E“”上的實例 。

我想將電話號碼提取到F：I欄中。 但是，如果一列已經有數據。 然后移動到下一個，如果數據有4個數字“將永遠不會大於4” ，則使用最后一個“ I”列作為最終位置

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 .Value2 Like "*???-???-????*" Then改為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