Excel UDF for capturing numbers within characters

穿精又带淫゛_ 提交于 2019-11-27 09:52:34

This is the John Coleman's suggested method:

Public Function GetTheNumbers(st As String) As String
    ary = Split(st, ";#")
    GetTheNumbers = ""

    For Each a In ary
        If IsNumeric(a) Then
            If GetTheNumbers = "" Then
                GetTheNumbers = a
            Else
                GetTheNumbers = GetTheNumbers & ", " & a
            End If
        End If
    Next a
End Function

If the pattern is fixed, and the location of the numbers never changes, you can assume the numbers will be located in the even places in the string. This means that in the array result of a split on the source string, you can use the odd indexes of the resulting array. For example in this string "Text;#Number;#Text;#Number" array indexes 1, 3 would be the numbers ("Text(0);#Number(1);#Text(2);#Number(3)"). I think this method is easier and safer to use if the pattern is indeed fixed, as it avoids the need to verify data types.

Public Function GetNums(src As String) As String
    Dim arr
    Dim i As Integer
    Dim result As String
    arr = Split(src, ";#") ' Split the string to an array.
    result = ""
    For i = 1 To UBound(arr) Step 2 ' Loop through the array, starting with the second item, and skipping one item (using Step 2).
        result = result & arr(i) & ", "
    Next
    If Len(result) > 2 Then
        GetNums = Left(result, Len(result) - 2) ' Remove the extra ", " at the end of the the result string.
    Else
        GetNums = ""
    End If
End Function

The numbers can vary from 1 digit to n digits (limit 7)

None of the other responses seems to take the provided parameters into consideration so I kludged together a true solution.

Option Explicit
Option Base 0    '<~~this is the default but I've included it because it has to be 0

Function numsOnly(str As String, _
                  Optional delim As String = ", ")
    Dim n As Long, nums() As Variant
    Static rgx As Object, cmat As Object

    'with rgx as static, it only has to be created once; beneficial when filling a long column with this UDF
    If rgx Is Nothing Then
        Set rgx = CreateObject("VBScript.RegExp")
    End If
    numsOnly = vbNullString

    With rgx
        .Global = True
        .MultiLine = False
        .Pattern = "[0-9]{1,7}"
        If .Test(str) Then
            Set cmat = .Execute(str)
            'resize the nums array to accept the matches
            ReDim nums(cmat.Count - 1)
            'populate the nums array with the matches
            For n = LBound(nums) To UBound(nums)
                nums(n) = cmat.Item(n)
            Next n
            'convert the nums array to a delimited string
            numsOnly = Join(nums, delim)
        End If
    End With
End Function

      

Regexp option that uses Replace

Sub Test()
Debug.Print StrOut("MyName;#123;#YourName;#3456;#HisName;#78")
End Sub

function

Option Explicit
Function StrOut(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
    .Pattern = "(^|.+?)(\d{1,7})"
    .Global = True
    If .Test(strIn) Then
        StrOut = .Replace(strIn, "$2, ")
        StrOut = Left$(StrOut, Len(StrOut) - 2)
    Else
        StrOut = "Nothing"
    End If
End With
End Function
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!