Question

我的栏目中有评论（超过5000个案例）。
这些评论有文字，数字，日期，一切。
我需要从这些评论中获取电话号码。
每个评论的电话号码都在随机位置，因此LEFT，MID或RIGHT无法使用

我到达的最接近的结果是Kutools =EXTRAXTNUMBERS() ......但我得到一行数字，其中包括日期，ID等。

更喜欢配方。：）

以下两个示例评论，所需的电话号码为粗体

2017年2月2日星期四下午2:37世界协调时间.3868 67076939 ，pers.pārv.Tatjana选择的电话结果：Norunacitālaikā - 2017-02-03 07:15 Wednesday， 2017年2月8日上午8:18世界协调时间.3868 nr。 67074071 -neeksistē，personāladaļasvad.Tatjananeatbild，arīnr。 67076600 选择的电话结果：NeceļFriday ，2017年2月10日上午7:15世界协调时间* .3868 *** piezv ap 13选择的电话会议结果：Norunacitālaikā - 2017-02-10 11:15

2017年2月2日星期四上午11:15世界协调时间4213zvanīt 66119908 选择的电话会议结果：Norunacitālaikā - 2017-02-07 09:00 2017年2月14日星期二12： 59 PM世界协调时间.4532 * anita @ dzintarniece @ rtp.lv选择的呼叫结果：Turpinātinternetā

Answer 1

这个小 UDF（）将返回字符串中的所有8位数字子字符串：

Public Function PHNum(s As String) As String
    Dim L As Long, i As Long, temp As String
    Dim CH As String
    L = Len(s)
    temp = ""
    PHNum = ""
    For i = 1 To L
        CH = Mid(s, i, 1)
        If IsNumeric(CH) Then
            temp = temp & CH
            If Len(temp) = 8 Then
                PHNum = PHNum & vbCrLf & temp
            End If
        Else
            temp = ""
        End If
    Next i
End Function

注意：

要在输出单元格中获取堆叠格式，请将其格式化以进行换行。

Answer 2

正则表达式解决方案

此UDF将文本中的电话号码作为数组提取给您。您最终可以使用Join将其转换为csv字符串，也可以将数组粘贴到一系列单元格中。

Function extractPhones(s As String) As String()
    Dim i As Long, matches, match, ret
    With CreateObject("VBScript.Regexp")
        .Global = True
        .Pattern = "\W[26]\d{7}\W"
        Set matches = .Execute(s)
    End With
    ReDim ret(1 To matches.Count) As String
    For Each match In matches
        i = i + 1
        ret(i) = Mid(match, 2, Len(match) - 2)
    Next
    extractPhones = ret
End Function

它使用与这些规格匹配的电话号码的正则表达式：

正好是8位数
从6或2开始
之前或之后不是字母数字字母，而是字母或标点字符。

Answer 3

使用UDF可以使用以下代码完成此操作：

使用它：

按ALT + F11
插入模块
粘贴代码
在Excel工作表中，使用此公式=get_phone("CELL_WITH_NUMBER_HERE")获取单元格中第一个8位数的序列。

<强>代码：

Public Function get_phone(cell As Range)
    Dim s As String
    Dim i As Integer
    Dim num
    Dim counter As Integer

    'get cell value
    s = cell.Value

    'set the counter
    counter = 0
    'loop through the entire string
    For i = 1 To Len(s)
        'check to see if the character is a numeric one
        If IsNumeric(Mid(s, i, 1)) = True Then
            'add it to the number
            num = num + Mid(s, i, 1)
            counter = counter + 1
            'check if we've reached 8 digits
            If counter = 8 Then
                get_phone = num
                Exit Function
            End If
         Else
         'was not numeric so reset counter and answer
         counter = 0
         num = ""
        End If
    Next i
End Function

示例图片：

Answer 4

另一个regexp选项，返回所有匹配单个单元格

请参阅https://regex101.com/r/Hdv65h/1

Function StrPhone(strIn As String) As String
    Dim objRegexp As Object
    Set objRegexp = CreateObject("VBScript.Regexp")
    With objRegexp
        .Global = True
        .Pattern = ".*?(\d{8})|.*$"
        StrPhone = Trim(.Replace(strIn, "$1 "))
    End With
End Function

Answer 5

Excel中有一个加载项，我在过去用于正则表达式（http://seotoolsforexcel.com/regexpfind/）。在您的情况下，它可能很复杂，因为您不知道电话号码出现在您的手机中的次数。对于这些情况，我建议您使用其他用户提供的VBA脚本。

从评论中提取电话号码

5 个答案: