Мне нужно решить неявное уравнение в VBA

Я хочу указать другие параметры, указанные в функции, и получить решение для (угла), но получаю сообщение об ошибке: «недопустимый вызов процедуры или аргумент». Ошибка выполнения 5. Мне нужно вызвать функцию в лист эксель. Это довольно длинное уравнение. Кроме того, может случиться так, что я вхожу в бесконечный цикл, но я не знаю, как этого избежать.

 Function calculateangle(r, h, C, g, d, m, t, x, y As Single) As Single

 Dim a As Single
 a = 0

 While y <> (d + r - r * Cos(a) + (x - (t - r + r * Sin(a))) * Tan(a) - (g 
 / (2 * ((((C * m * (2 * g * (h - (d + r - r * Cos(a)))) ^
 (1 / 2)) + m * (2 * g * (h - (d + r - r * Cos(a)))) ^ (1 / 2)) / (m +
 0.04593)) ^ 2) * (Cos(a)) ^ 2)) * (x - (t - r + r * Sin(a))) ^ 2)

     a = a + 0.01
 Wend

 MsgBox Round(a, 2)

 End Function

excel vba implicit equation-solving
person blend    schedule 23.03.2018    source источник
comment
Одно примечание: r, h, C, g, d, m, t, x - это все варианты, а не отдельные. Единственный сингл y   -  person Scott Craner    schedule 24.03.2018
comment
@ScottCraner Спасибо! Я объявил их все как одиночные, и теперь я получаю сообщение об ошибке: Выражение слишком сложное. Могу ли я что-нибудь сделать?   -  person blend    schedule 24.03.2018
comment
разбить формулу на более мелкие части.   -  person Scott Craner    schedule 24.03.2018
comment
@ScottCraner да, действительно, но дело в том, что я не могу разбить формулу на части, так как неизвестное (а) встречается во многих местах.   -  person blend    schedule 24.03.2018
comment
1. Если y уже выше или ниже (неизвестно, продвигает ли a = a + 0,01 результат вниз или вверх), то результат никогда не будет достигнут. 2. У вас может возникнуть проблема с a = a + 0,01, превышающим действительное значение equals, возможно, из-за 15-значной точности. Лучше округлить результат до значащих цифр y и увеличить a, чтобы не пропустить ни одного возможного результата совпадения. 3. Даже если вы нашли действительно равное уравнение, вы все равно а = а + 0,01 перед выходом из цикла, поэтому а — это первый шаг после равенства.   -  person    schedule 24.03.2018
comment
@Jeeped 1. Y всегда положителен, и a также должно быть положительным, поэтому, начиная с 0, он обязательно увеличивается. 2. Да, я округлил до 2 цифр, а также попробовал код на питоне, и он работает, но здесь я все еще получаю слишком сложное выражение.   -  person blend    schedule 24.03.2018
comment
Что вы получите, если перейдете на While y > (d + r ... ?   -  person    schedule 24.03.2018
comment
@Jeeped Expression снова слишком сложный, но в python я все еще получаю хороший результат   -  person blend    schedule 24.03.2018
comment
Почему бы не использовать Double? В любом случае, не могли бы вы сделать это минимально воспроизводимым примером? Как вы вызываете эту функцию?   -  person John Coleman    schedule 24.03.2018
comment
Кроме того, проверка чисел с плавающей запятой на равенство почти всегда ошибочна. y <> ..., вероятно, следует заменить сравнением, которое предполагает допуск.   -  person John Coleman    schedule 24.03.2018
comment
@JohnColeman Я нашел решение с помощью Решателя Excel. В противном случае я перепробовал все ваши предложения, но все равно получаю слишком сложную ошибку Expression. В любом случае спасибо всем.   -  person blend    schedule 24.03.2018
comment
@blend - значит проблема решена??   -  person ashleedawg    schedule 24.03.2018
comment
@blend Посмотрите здесь, пожалуйста. Вчера только написал и получил -1 :))) а сегодня ты второй уже кому надо. разбить формулу на более мелкие части. - Скотт Крейнер   -  person user6698332    schedule 24.03.2018

Ответы (2)


arrow_upward
1
arrow_downward

Одна очевидная проблема заключается в том, что вы используете Function, но не возвращаете значение.

Это действительно сложный кусок спагетти! Тем не менее, я предлагаю подход, подобный приведенному ниже, который поможет разделить различные биты и, таким образом, упростить отладку.

Function calculateangle(<...all the bits ...>) As Double
Dim a As Double
Dim tTolerance as Double
dim f1 as Double  ' sub sections to help untangle the spaghetti
Dim f2 as Double
Dim f3 as Double
Dim fFinal as Double
Dim tWithinTolerance as Boolean
    tWithinTolerance = false
    a = 0
    tTolerance = 0.01
    While not tWithinTolerance 
        f1 = d + r - r * Cos(a)
        f2 = m*2*g*(h - f1)
        f3 = x - (t - r + r * Sin(a)) 
        fFinal = (f1 + f3 * Tan(a) - (g  / (2 * ((((C * f2) ^
 (1 / 2)) + f2 ^ (1 / 2)) / (m + 0.04593)) ^ 2) * (Cos(a)) ^ 2)) * f3 ^ 2)
     tWithinTolerance = (Abs(y - fFinal) < tTolerance)
        a = a + 0.01
    Wend
    Calculateangle = a ' note how this sets a return value for the function
End Function

Я оставил округление (что является проблемой представления) коду, который вызывает эту функцию — таким образом вы можете отобразить ответ с любым уровнем детализации, который вы хотите!

(извините, если я исказил какие-либо расчеты по пути - но вы поняли концепцию!)

person AJD    schedule 24.03.2018

arrow_upward
0
arrow_downward

Для автора и тех, кто хочет разобраться с его пасьянсом. Надеюсь ничего не перепутал в скобках и упрощениях.

Do

    vCosA = Cos(a)
    vCosADR = d + r * (1 - vCosA) ' d + r - r * vCosA '
    vCosMGHADR = m * (2 * g * (h - vCosADR))
    vSinAXTR = (x - (t - r * (1 - Sin(a)))) ' - r + r * Sin(a)

   '((C * vCosMGHADR) + vCosMGHADR) == ((C + 1) * vCosMGHADR)

    If (y = _
            (vCosADR + vSinAXTR * Tan(a) - _
                (g / _
                    (2 * _
                        ( _
                            ( _
                                ((C + 1) * vCosMGHADR) / _
                                (m + 0.04593) _
                            ) ^ 2 _
                        ) * (vCosA ^ 2) _
                    ) _
                ) * vSinAXTR ^ 2 _
            )) Then Exit Do          ' *** EXIT DO ***

    a = a + 0.01

Loop
person user6698332    schedule 24.03.2018