Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" ( _
  ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Sub dgf()
' вытаскивание цифры из строки
    MsgBox myDbl("пФон0.1fgjh")
End Sub
Function myDbl(mySt As String) As Double
    'в референс подключить Microsoft VBScript Regular Expressions
    Dim str As String *  1 
    Dim str2 As String *  1 
    Dim myRegExp As New RegExp
    Dim colMatches As MatchCollection ' коллекция образцов
    
    myRegExp.MultiLine = False ' текст однострочный
    myRegExp.Global = False ' будем проходить до превого совпадения
    myRegExp.Pattern = "\d+" ' маска (любое количество любой цифры )
    If myRegExp.Test(mySt) Then 'проверка существует ли цифра в строке
        Set colMatches = myRegExp.Execute(mySt) ' запускаем!
        myDbl = colMatches( 0 )
        myRegExp.Pattern = "\d+[\./,]\d+" ' маска (любое количество любой цифры потом точка или запятая и опять любое количество любой цифры)
        If myRegExp.Test(mySt) Then 'проверка существует ли дробная цифра в строке
            Set colMatches = myRegExp.Execute(mySt) ' запускаем!
            On Error Resume Next
            myDbl = colMatches( 0 )
            If Err Then
                GetLocaleInfo GetUserDefaultLCID, &HE, str,  1  'системный раделитель
                If str = "." Then str2 = "," Else str2 = "."
                myDbl = Replace(colMatches( 0 ), str2, str)
            End If
        End If
    End If
End Function

Function Get_Dbl(Stng As String) As Double
    Dim Shablon As String
    Dim i As Long
    
    Shablon = "0123456789" & Application.International(xlDecimalSeparator)    'набор разрешенных
    Stng = Replace(Stng, ",", Application.International(xlDecimalSeparator))    'чтобы не проверять что в региональных ","  переводим в региональные
    Stng = Replace(Stng, ".", Application.International(xlDecimalSeparator))    'Все ". " переводим в региональные
    
    For i =  1  To Len(Stng)
        If InStr( 1 , Shablon, Mid(Stng, i,  1 )) =  0  Then Mid(Stng, i,  1 ) =  0  'Все что не подходит = 0
    Next
    If IsNumeric(Stng) Then Get_Dbl = CDbl(Stng)
End Function