如何求亲和数vba代码

183776928qqcom · 发表于 2024-11-20 13:26

如何求亲和数vba代码

loirol · 发表于 2024-11-20 13:47

本帖最后由 loirol 于 2024-11-20 14:30 编辑

2W已经要12秒了，范围再大不妙

飞天篮球猪 · 发表于 2024-11-20 14:05

仅供参考...减少遍历次数会快很多

183776928qqcom · 发表于 2024-11-20 15:05

感谢大神指导。  更新版---v2

由n 改到 n/2

效率提升一倍。

' 求给定数n的真因数的和
Function SumOfDivisors(n As Long) As Long
Dim sum As Long
Dim i As Long

sum = 0

' 遍历从1到n-1的所有数，找到所有的因数
For i = 1 To n/2
      If n Mod i = 0 Then
         sum = sum + i
      End If
Next i

SumOfDivisors = sum
End Function

飞天篮球猪 · 发表于 2024-11-20 15:52

还可以再压缩遍历次数，正因数都是成对出现的，比如16，2是正因数，那此时16/2=8也是正因数，所以遍历的上界是数字的平方根次数，这样的时间复杂度远比数字的一半要少。但要注意两个地方，1要单独拿出来，因为不能包括数字本身，另外还要注意这种情况，比如4*4=16，此时的4只能算1次......仅供参考。

z865593849 · 发表于 2024-11-20 16:12

求亲和数

大灰狼1976 · 发表于 2024-11-20 16:42

十万0.016秒

Sub test()
Dim n&, i&, j&, m&, m1&, sm&, s$
t = Timer
n = 10 ^ 5 - 1
ReDim arr&(1 To n)
For i = 2 To Int(Sqr(n))
m1 = i * i
arr(m1) = arr(m1) + i
For j = m1 + i To n Step i
arr(j) = arr(j) + i + j / i
Next j
Next i
For i = 2 To n
If arr(i) > 0 Then
j = arr(i) + 1
If j <= n And i <> j Then If arr(j) = i - 1 Then s = s & Chr(10) & i
End If
Next i
MsgBox Mid(s, 2) & Chr(10) & Format(Timer - t, "0.000s")
End Sub

复制代码

飞天篮球猪 · 发表于 2024-11-21 10:51

仅供参考...

寂寞只为自由 · 发表于 2024-11-21 12:22

占位学习学习

		自动登录	找回密码
密码			免费注册

[原创] 如何求亲和数vba代码

评分