计算两个正整数相乘等于1亿的所有组合

开庸秦忠

普通的函数穷举肯定费时费力，超出单列行上限，所以求vba代码或其他思路。

yjh_27

1. Sub aa()
   
2. arr = zuhe(100000000)
   
3. Range("a1").Resize(UBound(arr), 2) = arr
   
4. End Sub
   
5. 
   
6. Function zuhe(a)
   
7. s = Int(a ^ 0.5)
   
8. ReDim srr(1 To s, 1 To 2)
   
9. s1 = 0
   
10. For i = 1 To s
    
11.     b = a / i
    
12.     If b = Int(b) Then
    
13.         s1 = s1 + 1
    
14.         srr(s1, 1) = i
    
15.         srr(s1, 2) = b
    
16.     End If
    
17. Next
    
18. ReDim scrr(1 To s1, 1 To 2)
    
19. For i = 1 To s1
    
20.     scrr(i, 1) = srr(i, 1)
    
21.     scrr(i, 2) = srr(i, 2)
    
22. Next
    
23. zuhe = scrr
    
24. End Function
    
25. 
    

复制代码

山菊花

用函数穷举也很快，这点计算不算什么。
A1=IF(MOD(10^8,ROW())=0,ROW(),"")
B1=IF(A1="","",10^8/A1)
将公式下拉到10000行。

yjh_27

代码审核中。。。

GG函数

1. Sub findFactors()
   
2.     Dim num As Long
   
3.     Dim i As Long
   
4.     Dim row As Long
   
5.     Dim 数组() As Long
   
6.    
   
7.     num = 100000000 '乘积是正整数（偶数、个位为0）
   
8.     row = 0
   
9.    
   
10.     ReDim 数组(1 To Rows.Count, 1 To 2)
    
11.    
    
12.     For i = 1 To num
    
13.         If num Mod i = 0 Then ' Mod，判断是否能够除尽
    
14.             row = row + 1
    
15.             数组(row, 1) = i
    
16.             数组(row, 2) = num / i
    
17.         End If
    
18.     Next i
    
19.     Range("A1:B" & row).Value = 数组
    
20. End Sub

复制代码

开庸秦忠

GG函数 发表于 2024-1-11 23:27

正解，确定是81种组合，和我之前计算的组合类型一致，但只是无法了解其中的组合逻辑。

开庸秦忠

yjh_27 发表于 2024-1-11 23:03
代码审核中。。。

刚试了试代码，也算是穷举完了，乘数和被乘数交换率总共81种可能性，厉害

ykcbf1100

开庸秦忠 发表于 2024-1-12 07:28
正解，确定是81种组合，和我之前计算的组合类型一致，但只是无法了解其中的组合逻辑。

正解应该是41个吧，象2*50000000和50000000*2应该算同一个组合了。

ykcbf1100

41个不重复组合的代码，供参考。。。

fgq5910

在组合中认为[a,b],[b,a]是等效的，在排列中认为两者是不等的