执行积分循环时Excel冻结，求球面辐射源剂量率计算优化方案

我编写了用于计算球面辐射源剂量率的VBA二重积分函数，但当精度设置为0.1时Excel会出现冻结；降低精度后可正常运行，但不确定是否满足计算要求。已尝试多种方法均无效，无法判断是循环逻辑错误还是Excel无法处理大数据量，恳请解答！

Function EqSphrPol(Th, Ph, Xk, Yk)
Application.MultiThreadedCalculation.Enabled =  True
R = 1
Xa = 4
Ya = 2
Za = 1
Zk = 1
L = (Xa - Xk) ^ 2 + (Ya - Yk) ^ 2
RSp = L + R ^ 2 * Sin(Th) ^ 2 - 2 * R * Sqr(L) * Sin(Th) * Cos(Ph) + (Za - Zk + R * Cos(Th)) ^ 2
EqSphrPol = (R ^ 2 * Sin(Th)) / RSp
End Function

Function Int1SphrPol(Ph, Xk, Yk)
N = 10: S2 = 0: Eps = 0.1 'Eps-variable of precision
Do
 St = (3.141) / N
 S1 = S2
 For M = 1 To N
  S2 = S2 + EqSphrPol(0 + M * St, Ph, Xk, Yk)
 Next
 S2 = St * S2
 N = 2 * N
Loop Until Abs(S1 - S2) <= Eps
Int1SphrPol = S2
End Function


Function Int2SphrPol(Xk, Yk)
R = 1
G = 8.46 * 10 ^ (-17)
ActS = 12 / (4 * 3.141 * R ^ 2)
N2 = 10: S22 = 0: Eps = 0.1
Do
 St2 = (3.141) / N2
 S11 = S22
 For K = 1 To N2
  S22 = S22 + Int1SphrPol(0 + K * St2, Xk, Yk)
 Next
 S22 = St2 * S22
 N2 = 2 * N2
Loop Until Abs(S11 - S22) <= Eps
S22 = S22 * ActS * G
Int2SphrPol = S22
End Function

已尝试的解决方法：

• 等待2小时，无效果
• 关闭屏幕更新，无效果
• 更换积分方法（梯形法、辛普森法），仍无效
• 降低精度可运行，但不认为这是合适解决方案

内容的提问来源于stack exchange，提问作者Greg32