Как найти число в строке vba

I was looking for the answer of the same question but for a while I found my own solution and I wanted to share it for other people who will need those codes in the future. Here is another solution without function.

Dim control As Boolean
Dim controlval As String
Dim resultval As String
Dim i as Integer

controlval = "A1B2C3D4"

For i = 1 To Len(controlval)
control = IsNumeric(Mid(controlval, i, 1))
If control = True Then resultval = resultval & Mid(controlval, i, 1)
Next i

resultval = 1234

answered May 22, 2019 at 6:23

This a variant of brettdj’s & pstraton post.

This will return a true Value and not give you the #NUM! error. And D is shorthand for anything but digits. The rest is much like the others only with this minor fix.

Function StripChar(Txt As String) As Variant
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "D"
    StripChar = Val(.Replace(Txt, " "))
End With
End Function

answered Sep 25, 2018 at 19:29

This is based on another answer, but is just reformated:

Assuming you mean you want the non-numbers stripped out, you should be able to use something like:

'
' Skips all characters in the input string except digits
'
Function GetDigits(ByVal s As String) As String
    Dim char As String
    Dim i As Integer
    GetDigits = ""
    For i = 1 To Len(s)
        char = Mid(s, i, 1)
        If char >= "0" And char <= "9" Then
            GetDigits = GetDigits + char
        End If
    Next i
End Function

Calling this with:

Dim myStr as String
myStr = GetDigits("3d1fgd4g1dg5d9gdg")
Call MsgBox(myStr)

will give you a dialog box containing:

314159

and those first two lines show how you can store it into an arbitrary string variable, to do with as you wish.

answered May 5, 2019 at 12:12

Alternative via Byte Array

If you assign a string to a Byte array you typically get the number equivalents of each character in pairs of the array elements. Use a loop for numeric check via the Like operator and return the joined array as string:

Function Nums(s$)
  Dim by() As Byte, i&, ii&
  by = s: ReDim tmp(UBound(by))                    ' assign string to byte array; prepare temp array
  For i = 0 To UBound(by) - 1 Step 2               ' check num value in byte array (0, 2, 4 ... n-1)
      If Chr(by(i)) Like "#" Then tmp(ii) = Chr(by(i)): ii = ii + 1
  Next i
  Nums = Trim(Join(tmp, vbNullString))             ' return string with numbers only
  End Function

Example call

Sub testByteApproach()
  Dim s$: s = "a12bx99y /:3,14159"                 ' [1] define original string
  Debug.Print s & " => " & Nums(s)                  ' [2] display original string and result
End Sub

would display the original string and the result string in the immediate window:

  a12bx99y /:3,14159 => 1299314159

answered May 22, 2019 at 9:12

Based on @brettdj’s answer using a VBScript regex ojbect with two modifications:

• The function handles variants and returns a variant. That is, to take care of a null case; and
• Uses explicit object creation, with a reference to the “Microsoft VBScript Regular Expressions 5.5” library

Function GetDigitsInVariant(inputVariant As Variant) As Variant
  ' Returns:
  '     Only the digits found in a varaint.
  ' Examples:
  '     GetDigitsInVariant(Null) => Null
  '     GetDigitsInVariant("") => ""
  '     GetDigitsInVariant(2021-/05-May/-18, Tue) => 20210518
  '     GetDigitsInVariant(2021-05-18) => 20210518
  ' Notes:
  '     If the inputVariant is null, null will be returned.
  '     If the inputVariant is "", "" will be returned.
  ' Usage:
  '     VBA IDE Menu > Tools > References ...
  '       > "Microsoft VBScript Regular Expressions 5.5" > [OK]

  ' With an explicit object reference to RegExp we can get intellisense
  ' and review the object heirarchy with the object browser
  ' (VBA IDE Menu > View > Object Browser).
  Dim regex As VBScript_RegExp_55.RegExp
  Set regex = New VBScript_RegExp_55.RegExp
  
  Dim result As Variant
  result = Null
  
  If IsNull(inputVariant) Then
    result = Null
    
  Else
    With regex
      .Global = True
      .Pattern = "[^d]+"
      result = .Replace(inputVariant, vbNullString)
    End With
  End If
  
  GetDigitsInVariant = result
End Function

Testing:

Private Sub TestGetDigitsInVariant()
  Dim dateVariants As Variant
  dateVariants = Array(Null, "", "2021-/05-May/-18, Tue", _
          "2021-05-18", "18/05/2021", "3434 ..,sdf,sfd 444")
  
  Dim dateVariant As Variant
  For Each dateVariant In dateVariants
    Debug.Print dateVariant & ": ", , GetDigitsInVariant(dateVariant)
  Next dateVariant
  Debug.Print
End Sub

answered Jan 4, 2021 at 19:20

Код: Выделить всё

dim I as long, pos as long

for i=0 to 9
   pos=instr(stroka,cstr(i))
   if pos>0 then
      number=val(mid(stroka,pos))
      Exit for'а может и не надо...
   enb if
next

Код: Выделить всё

for n = 1 to len(s)
  d= val (mid$(s,n))
  if d<>0 then exit for
next n
debug.print d


найдет ПЕРВОЕ число в строке.

Простите за глупость

Что такое like??

Это такой оператор, или функция???

Ичто он/она делает.

Например, st=”fsdf342hfdg”

Тогда:

dim chislo as string

dim ch as string

for i=1 to len(st)

ch=mid(st,i,1)

if IsInt(ch) =true then ‘ я не помню точно: IsInt или IsInteger… посмотришь сам

chislo = chislo & ch

endif

next i

dim a as integer

a = int(chislo) ‘ а – нужное тебе число

Вроде бы, должно работать, не проверял…

Если что, пиши…

Короче, в общем виде…

Код: Выделить всё

function filter(byval s as string, byval f as string) as string
  dim i as long, tmpStr as string
  for i=1 to len(s)
    tmpstr=mid$(s,i,1)
    if instr(f,tmpstr) then filter=filter+tmpstr
  next
end function

debug.? filter("dfgsdf04567d","0123456789.")

Sanya Z

Насколько я понял вышеназванные коды находят только первую цифру числа, а как выдрать все число

Ты бы хоть проверил, что тебе написали, а потом делел выводы. Мой пример дает ВСЕ число, только допиши вначале:

Код: Выделить всё

  DIM n as integer, d as duoble, s as string
  s="jddjk-35.345hkjd lsa "


я это не вписал – думал и так понятно.

GSerg

Вариант более, чем с одним числом, например такой:

Код: Выделить всё

Debug.Print filter("dfgsdf04567d34656", "0123456789.")


или с несколькими десятичными точками, дает неверный результат.

Я тут немного помучался, и нашёл новый способ решения… правда, переменных многовато…

Код: Выделить всё

Dim st As String
    st = "ksjhgk -32542.25 fkgjdf"
Dim i As Integer
Dim ch As String
Dim ch2 As String
Const stroka = "1234567890"
Dim chislo As String

For i = 1 To Len(st)
    ch = Mid(st, i, 1)
    Select Case ch
        Case "-"
            ch2 = Mid(st, i + 1, 1)
            If InStr(stroka, ch2) Then
                chislo = chislo & Mid(st, i, 2)
                i = i + 1
            End If

            Case "."
            If i <> 1 Then
                ch2 = Mid(st, i - 1, 1)
                If InStr(stroka, ch2) Then
                    chislo = chislo & Mid(st, i, 1)
                End If
            End If
    End Select

        If InStr(stroka, ch) Then
        chislo = chislo & Mid(st, i, 1)
    End If

    Next i

chislo – Нужное тебе число (в текстовом виде)

Далее, в зависимости от типа числа (Integer или Double), преобразовываешь его в нужный тебе тип…