请问有数学好的老师吗？我这有个公式请帮忙改一下，谢谢了。

江南156

wanghan519 发表于 2023-5-3 08:54
反推不会，还是逼近求解吧，写了个函数，写的不好凑活用。。。

谢谢  接近于正确值了  不过我这个要求精度     

wanghan519

江南156 发表于 2023-5-3 09:19
谢谢  接近于正确值了  不过我这个要求精度

那就把0.0001那里再改小一些

江南156

wanghan519 发表于 2023-5-3 09:23
那就把0.0001那里再改小一些

请问在哪里改？我不懂

高个子

江南156 发表于 2023-5-3 05:21
谢谢，用我的那个公式不能逆向的计算吗？

可以，但是最后要求解一元四次方程，公式很长

高个子

江南156 发表于 2023-5-3 06:18
请问 用单变量求解能批量计算A列的吗？

当然可以了，不过得用VBA解决

niko88819

wanghan519 发表于 2023-5-3 08:54
反推不会，还是逼近求解吧，写了个函数，写的不好凑活用。。。

老师可以贴出代码分享吗?代码有任何简体或是繁体字都自动遗失成空

wanghan519

niko88819 发表于 2023-5-3 09:33
老师可以贴出代码分享吗?代码有任何简体或是繁体字都自动遗失成空

不敢称老师，就是二分法求解，写的不好见笑了

1. Public Function p(x As Double, y As Double) As Double
   
2.     p = WorksheetFunction.Pi() * ((x / 2) + (y / 2)) * (1 + 3 * (((x / 2) - (y / 2)) / ((x / 2) + (y / 2))) ^ 2 / (10 + Sqr(4 - 3 * (((x / 2) - (y / 2)) / ((x / 2) + (y / 2))) ^ 2)))
   
3. End Function
   
4. 
   
5. Public Function b(c As Double, a As Double) As Double
   
6.     Dim x As Double, y As Double, z As Double
   
7.     x = 0
   
8.     y = a
   
9.     If c < p(a, 0) Then
   
10.         b = -1
    
11.         Exit Function
    
12.     End If
    
13.     While c > p(a, y)
    
14.         x = y
    
15.         y = y + 100
    
16.     Wend
    
17.     Do
    
18.         z = (x + y) / 2
    
19.         If c > p(a, z) Then
    
20.             x = z
    
21.         Else
    
22.             y = z
    
23.         End If
    
24.     Loop While Abs(c - p(a, z)) > 0.0000000001
    
25.     b = z
    
26. End Function

复制代码

江南156

高个子 发表于 2023-5-3 09:28
当然可以了，不过得用VBA解决

这个VBA要怎么写啊？ 我加你好友了

niko88819

向 wanghan519 老师学习 , 借花献佛

短轴 =Function Ellipse_Short_Axis(周长,长轴)

1. Public Function Ellipse_Short_Axis(c As Double, a As Double) As Double
   
2.     Dim x As Double, y As Double, z As Double, p_value As Double
   
3.     x = 0
   
4.     y = a
   
5.     If c < p(a, 0) Then
   
6.         Ellipse_Short_Axis = -1
   
7.         Exit Function
   
8.     End If
   
9.     While c > p(a, y)
   
10.         x = y
    
11.         y = y + 100
    
12.     Wend
    
13.     Do
    
14.         z = (x + y) / 2
    
15.         p_value = p(a, z)
    
16.         If c > p_value Then
    
17.             x = z
    
18.         Else
    
19.             y = z
    
20.         End If
    
21.     Loop While Abs(c - p_value) > 0.000000000001
    
22.     Ellipse_Short_Axis = z
    
23. End Function

复制代码

高个子

江南156 发表于 2023-5-3 10:01
这个VBA要怎么写啊？ 我加你好友了

楼上帮你写好了。。。