VBA: обработка строки ?

[Stem79]

Необходимо реализовать макрофункцию по спецификации:

Function ПАРСИНГ (r1 As String, v1 As Double) as Double

r1 - это строка вида 0-5;1-2;2-0;3-2;4-0;5-1;
v1 - числовое значение;

первое число: число до дефиса;
второе число: число после дефиса;

алгоритм функции:
1. из каждого первого числа строки r1 вычесть v1 и результат возвести в квадрат;

получится новый ряд r1' вида: (0-v1)^2-5;(1-v1)^2-2;...(5-v1)^2-1;

2. каждое первое число ряда r1' умножить на второе число ряда r1'

получится ряд r1'' (0-v1)^2*5;(1-v1)^2*2;...(5-v1)^2*1;

3. сложить числа ряда r1'', каждое число разделено знаком ";"

получится сумма, которую должна вернуть функция ПАРСИНГ.

Как это реализовать?

Спасибо!

[IgorGO]

Function Parsing(s As String, v As Double) As Double
  Parsing = eq(s, v, 0)
End Function

Function eq(s As String, v As Double, i As Long) As Double
  If Len(s) > 4 * i Then eq = (Val(Mid(s, i * 4 + 1, 1)) - v) ^ 2 * Val(Mid(s, i * 4 + 3, 1)) + eq(s, v, i + 1)
End Function

Sub main()
  MsgBox Parsing("0-5;1-2;2-0;3-2;4-0;5-1;", 3)
End Sub

[EducatedFool]

А вот и мой вариант:

Sub test()
    Debug.Print ПАРСИНГ("0-5;1-2;2-0;3-2;4-0;5-1;", 2)
End Sub

Function ПАРСИНГ(r1 As String, v As Double) As Double
    For Each txt In Split(r1, ";")
        If txt Like "*#-#*" Then
            v1& = Val(Split(txt, "-")(0))
            v2& = Val(Split(txt, "-")(1))
            ПАРСИНГ = ПАРСИНГ + (v1 - v) ^ 2 * v2
        End If
    Next
End Function

PS: Игорь, ты научился вызывать у людей вывих мозга не только формулами, но теперь уже и макросами? ))
Я вообще не понял, как работает твой вариант с рекурсией

[IgorGO]

или так:

Function Parsing(s As String, v As Double, Optional i As Long = 0) As Double
    If Len(s) > 4 * i Then Parsing = (Val(Mid(s, i * 4 + 1, 1)) - v) ^ 2 * Val(Mid(s, i * 4 + 3, 1)) + Parsing(s, v, i + 1)
End Function

Sub main()
  MsgBox Parsing("0-5;1-2;2-0;3-2;4-0;5-1;", 3)
End Sub

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

[EducatedFool]

Я тоже могу покороче)

Sub test()
    Debug.Print ПАРСИНГ("0-5;1-2;2-0;3-2;4-0;5-1;", 2)
End Sub

Function ПАРСИНГ(r1 As String, v As Double) As Double: On Error Resume Next: For Each txt In Split(r1, ";"): ПАРСИНГ = ПАРСИНГ + IIf(txt Like "*#-#*", (Val(Split(txt, "-")(0)) - v) ^ 2 * Val(Split(txt, "-")(1)), 0): Next: End Function

[Stem79]

Круто, спасибо парни!

[Казанский]

До кучи

Function ПАРСИНГ(ByVal r1 As String, v1 As Double) As Double
ПАРСИНГ = Evaluate("(" & Replace(Replace(r1, ";", "+("), "-", "-" & Str(v1) & ")^2*") & "0)")
End Function

Sub test()
Debug.Print ПАРСИНГ("0-5;1-2;2-0;3-2;4-0;5-1;", 3)
End Sub

[doober]

Первым в забеге к финишу пришёл Казанский

[IgorGO]

Согласен с Серегой.

Леша, красиво! что тут еще скажешь. Меня прет от твоего варианта, будто это я написал.

[Sasha_Smirnov]

Зато у меня с картинкой!

Option Explicit
Dim ВЫРАЖЕНИЕ

Sub ВЫЗОВ()
    Dim result
    result = ПАРСИНГ("0-5;1-2;2-0;3-2;4-0;5-1; ", 0)
    MsgBox ВЫРАЖЕНИЕ & " = " & result
End Sub

Function ПАРСИНГ(r1 As String, v1 As Double) As Double
Dim r, rr, units, newbound, i
units = Split(Trim(r1), ";") 'разбили r1 на элементы массива units()
'Trim обрезает пробелы по краям строки

While Not Left(CStr(units(UBound(units))), 1) Like "[0-9]"
'пока последний элемент начииется не с цифры (т. е. пуст либо это пробел)
    newbound = UBound(units) - 1
    ReDim Preserve units(0 To newbound) 'убрали из массива units пустой «хвост»
Wend
'теперь имеем массив units - из элементов вида "X-Y" (где X начинается с цифры)

r = units                   'создали в r копию массива units
ReDim rr(0 To newbound)     'создали в rr аналог массива units (по размерности)

For i = 0 To UBound(units)
    r(i) = Val(units(i))    'здесь элементами массива сновятся 1-е эл-ты units (до -)
    rr(i) = (r(i) - v1) ^ 2 '1-е элементы нового ряда r1' (алгоритм, пункт 1)
    units(i) = rr(i) & Mid(units(i), InStr(units(i), "-"))
    'здесь мы в i-м элементе заменили на rr(i) число, стоящее до дефиса
    
    units(i) = Replace(units(i), "-", "*") 'замена дефиса на звёздочку в элементе i
        
        MsgBox "rr(" & i & ") = " & rr(i) & vbCr & vbCr & _
                "units(" & i & ") = " & units(i) & vbCr & vbCr & _
        Application.Evaluate(units(i))
Next

    ВЫРАЖЕНИЕ = Join(units, "+") 'соединяем плюсиками - получаем вычисляемое выражение
    ПАРСИНГ = Application.Evaluate(ВЫРАЖЕНИЕ) 'выдаём сумму
End Function