Процент соответствия Excel VBA RegEx

Question

У меня есть ячейка с текстом, который гласил: «Сегодняшний прирост составил 5,24% со вчерашнего дня». Я хотел бы извлечь процент. Ранее я написал UDF, который я назвал AnyNumber, который я изменял на AnyPercent. Я проверил свой шаблон на нескольких сайтах, но он не работает в Excel. Спасибо!

Function AnyPercentage(Text As String) As Integer
With CreateObject("VBScript.RegExp")
  .Pattern = "[0-9]{1,100}(\.[0-9]{1,100})?\%"
  If .test(Text) Then AnyPercentage = .Execute(Text)(0)
End With
End Function

Answer 1

С регулярным выражением:

Function AnyPercentage(Text As String) As Integer
    With CreateObject("VBScript.RegExp")
      .Pattern = "[0-9]+\.[0-9]+\%"
      AnyPercentage = "-1"
      If .test(Text) Then
         AnyPercentage = Replace(.Execute(Text)(0), "%", "")
      End If
    End With
End Function

Без регулярного выражения:

Sub GetPercentage()
    Dim a
    a = Split("Today's gain was 5.24% from yesterday%", "%")
    Dim Hsl
    If UBound(a) > 0 Then
       Hsl = a(0)
       a = Split(Hsl, " ")
       r = UBound(a)
       If IsNumeric(a(r)) Then
          Hsl = a(r) & "%"
       End If
    End If
    MsgBox Hsl
End Sub

В функции

Function GetPercentage(myVal as string) as string
    Dim a
    a = Split(myVal , "%")
    Dim Hsl
    If UBound(a) > 0 Then
       Hsl = a(0)
       a = Split(Hsl, " ")
       r = UBound(a)
       If IsNumeric(a(r)) Then
          Hsl = a(r) & "%"
       End If
    End If
    GetPercentage = Hsl
End Function

Answer 2

Проблема здесь в том, что вы устанавливаете тип возвращаемого значения функции integer.

Когда регулярное выражение находит совпадение, оно возвращает строку в этом случае 5.24%.

У вас есть пара альтернатив:

1. Найдите только цифры в шаблоне регулярных выражений ( см. Эту ссылку )
2. Используйте vba для извлечения цифр, а затем приведите их как двойные или одинарные (CDbl или CSng)

Код для второй альтернативы:

Sub test()

    Dim anyResult As String
    Dim result As Double
    anyResult = AnyPercentage(Range("A1").Value)
    result = ExtractPercentage(anyResult)

End Sub

Function AnyPercentage(Text As String) As String
With CreateObject("VBScript.RegExp")
  .Pattern = "[0-9]{1,100}(\.[0-9]{1,100})?\%"
  If .test(Text) Then AnyPercentage = .Execute(Text)(0)

End With
End Function


Public Function ExtractPercentage(ByVal PercentageString As String) As Double
    ' Credits: https://stackoverflow.com/a/7885550/1521579
    If (Right(PercentageString, 1) = "%") Then ExtractPercentage = CDbl(Left(PercentageString, Len(PercentageString) - 1))
End Function

Иметь в помните, что он чувствителен к вашим текущим региональным настройкам (разделитель миль и десятичных дробей)