从每个单元格的字符串中提取数字

时间:2018-09-03 19:15:36

标签: excel vba

我正在尝试编写从文本中提取 X 个连续数字的代码。

例如,如果我想在文本中提取5个连续数字:

  • 单元格A1:dsuad28d2hr 22222222 11111 d33d11103
  • 单元格B2: 11111 (需要)

我可以使它只用于5个数字的文本,但是问题是我的文本是否包含其他大于5的连续数字。

Sub ExtractNum2()
    Dim Caract() As String
    Dim i As Integer
    Dim j As Integer
    Dim z As Integer
    Dim cont As Integer
    Dim goal As Integer
    Dim Protocolo() As String
    Dim cel As String
    Dim lin As Long

    lin = Range("A1", Range("A1").End(xlDown)).Rows.Count 'Repeat for each line
    For z = 1 To lin
        cel = Cells(z, 1)
        ReDim Caract(Len(cel))
        ReDim Protocolo(Len(cel))
        cont = 0
        For i = 1 To Len(cel)
            Caract(i) = Left(Mid(cel, i), 1)
            If IsNumeric(Caract(i)) Then 'Character check
                cont = cont + 1
                Protocolo(cont) = Caract(i)
                'If Not IsNumeric(Caract(6)) And cont = 5 Then**
                If cont = 5       '
                    Dim msg As String
                    For j = 1 To 5
                        msg = msg & Protocolo(j)
                    Next j
                    Cells(z, 2) = msg 'fills column B
                    msg = ""
                End If
            Else
                cont = 0
            End If
        Next i
    Next z 'end repeat
End Sub

我正在尝试使用:

 If Not IsNumeric(Caract(6)) And cont = 5 Then

但是它不起作用,我的输出是:B2: 22222,但是我想要11111。 我想念什么?

编辑 对不起,我不清楚。我想提取6> x> 4(x = 5)的X个数字。我不想要22222,因为它在我的示例中有8个连续数字,而11111有5个连续数字。

2 个答案:

答案 0 :(得分:4)

UDF:

Function GetNum(cell)
    With CreateObject("VBScript.RegExp")
        .Pattern = "\b(\d{5})\b"
        With .Execute(cell)
            If .Count > 0 Then GetNum = .Item(0).SubMatches(0)
        End With
    End With
End Function

更新:

如果要返回错误(例如#N/A)而不是被叫方的默认数据类型,则可以编写以下内容:

Function GetNum(cell)
    With CreateObject("VBScript.RegExp")
        .Pattern = "\b(\d{5})\b"
        With .Execute(cell)
            If .Count > 0 Then
                GetNum = .Item(0).SubMatches(0)
            Else
                GetNum = CVErr(xlErrNA)
            End If
        End With
    End With
End Function

答案 1 :(得分:1)

我用一个包含“ Yjuj 525211111x5333332s5”的单元格进行了测试,以测试是否连续2个5个字符被捕获,并且效果很好。

Sub Macro_Find_Five()

    Dim str As String
    Dim tmp As String
    Dim cntr As Integer
    Dim result As String

    str = Sheet1.Cells(1, 1).Value

    tmp = ""
    cntr = 1
    col = 2
    result = ""

    'For Loop for tracing each charater
    For i = 1 To Len(str)

        'Ignore first starting character
        If i > 1 Then

            'If the last character matches current character then
            'enter the if condition
            If tmp = Mid(str, i, 1) Then

                'concatenate current character to a result variable 
                result = result + Mid(str, i, 1)

                'increment the counter
                cntr = cntr + 1

            Else

               'if the previous character does not match
               'reset the cntr to 1
                cntr = 1

               'as well initialize the result string to "" (blank)
                result = ""

            End If

        End If

        'if cntr matches 5 i.e. 5 characters traced enter if condition
        If cntr = 5 Then

           'adding to next column the result found 5 characters same
            Sheet1.Cells(1, col).Value = result

            'increment the col (so next time it saves in next column)
            col = col + 1

            'initializing the variables for new search
            cntr = 1
            tmp = ""
            result = ""

        End If

       'stores the last character
        tmp = Mid(str, i, 1)

        'if first character match concatenate.
        If cntr = 1 Then
            result = result + Mid(str, i, 1)
        End If

    Next i

End Sub