Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = 2 * (n + 1) ^ 2
a = Val(n + 1)
Do While a <= Val(2 * n)
b = Val(2 * n)
Do While b <= Val(n * (n + 1)) And b > a
k = Val(a + b)
c = Val(a * b) / Val(k)
If c = n And k <= m Then
m = k
s = "{" & a & "," & b & "}"
s2 = n & "  " & m & "  " & s & vbCrLf
s3 = s3 + 1
End If

b = Val(b + 1)
Loop
a = Val(a + 1)
Loop

If s3 > 0 Then
Text2 = s2 & "需要比较的解的个数为： " & s3 & "组"
Else
Text2 = "无解"
End If

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""

End Sub

结果举例：
2  9  {3,6}
需要比较的解的个数为： 1组

3  16  {4,12}
需要比较的解的个数为： 1组

4  18  {6,12}
需要比较的解的个数为： 2组

5  36  {6,30}
需要比较的解的个数为： 1组

6  25  {10,15}
需要比较的解的个数为： 4组

7  64  {8,56}
需要比较的解的个数为： 1组

8  36  {12,24}
需要比较的解的个数为： 3组

显示全部结果：
2  9  {3,6}  
  解的个数为： 1组

3  16  {4,12}  
  解的个数为： 1组

4  25  {5,20}  4  18  {6,12}  
  解的个数为： 2组

5  36  {6,30}  
  解的个数为： 1组

6  49  {7,42}  6  32  {8,24}  6  27  {9,18}  6  25  {10,15}  
  解的个数为： 4组

7  64  {8,56}  
  解的个数为： 1组

8  81  {9,72}  8  50  {10,40}  8  36  {12,24}  
  解的个数为： 3组

9  100  {10,90}  9  48  {12,36}  
  解的个数为： 2组

10  121  {11,110}  10  72  {12,60}  10  49  {14,35}  10  45  {15,30}  
  解的个数为： 4组

11  144  {12,132}  
  解的个数为： 1组

12  169  {13,156}  12  98  {14,84}  12  75  {15,60}  12  64  {16,48}  12  54  {18,36}  12  50  {20,30}  12  49  {21,28}  
  解的个数为： 7组

…………………………………………………………………………

代码如下：

Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = 2 * (n + 1) ^ 2
a = Val(n + 1)
Do While a <= Val(2 * n)
b = Val(2 * n)
Do While b <= Val(n * (n + 1)) And b > a
k = Val(a + b)
c = Val(a * b) / Val(k)
If c = n And k <= m Then

s = "{" & a & "," & b & "}  "
s2 = s2 & n & "  " & k & "  " & s
s3 = s3 + 1
End If

b = Val(b + 1)
Loop
a = Val(a + 1)
Loop

If s3 > 0 Then
Text2 = s2 & vbCrLf & "  解的个数为： " & s3 & "组"
Else
Text2 = "无解"
End If

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""

End Sub

[此贴子已经被作者于2026-1-21 19:10编辑过]

12  169  {13,156}  12  98  {14,84}  12  75  {15,60}  12  64  {16,48}  12  54  {18,36}  12  50  {20,30}  12  49  {21,28}    解的个数为： 7组

18  361  {19,342}  
18  200  {20,180}  
18  147  {21,126}  
18  121  {22,99}  
18  96  {24,72}  
18  81  {27,54}  
18  75  {30,45}  
  解的个数为： 7组

20  441  {21,420}  
20  242  {22,220}  
20  144  {24,120}  
20  125  {25,100}  
20  98  {28,70}  
20  90  {30,60}  
20  81  {36,45}  
  解的个数为： 7组

24  625  {25,600}  
24  338  {26,312}  
24  243  {27,216}  
24  196  {28,168}  
24  150  {30,120}  
24  128  {32,96}  
24  121  {33,88}  
24  108  {36,72}  
24  100  {40,60}  
24  98  {42,56}  
  解的个数为： 10组
……………………………………………………………………………………
代码如下：
Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = 2 * (n + 1) ^ 2
a = Val(n + 1)
Do While a <= Val(2 * n)
b = Val(2 * n)
Do While b <= Val(n * (n + 1)) And b > a
k = Val(a + b)
c = Val(a * b) / Val(k)
If c = n And k <= m Then

s = "{" & a & "," & b & "}  "
s2 = s2 & n & "  " & k & "  " & s & vbCrLf
s3 = s3 + 1
End If

b = Val(b + 1)
Loop
a = Val(a + 1)
Loop

If s3 > 0 Then
Text2 = s2 & "  解的个数为： " & s3 & "组"
Else
Text2 = "无解"
End If

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""

End Sub

将六分之一拆成两个单位分数的和，不重复结果有哪几种？
https://zhidao.baidu.com/question/492929876883832492.html

设1/6=1/a+1/b（a和b都是大于等于2的正整数）
把式子通分就得到：1/6=(a+b)/ab，进而得到ab=6a+6b, 移项得ab-6a=6b，左边再进行因式分解得a(b-6)=6b…………⑴
或者ab-6b=6a，左边再进行因式分解得b(a-6)=6a…………⑵
⑴*⑵得：ab(a-6)(b-6)=36ab，约掉ab得(a-6)(b-6)=36
而36=1×36=2×18=3×12=4×9=6×6
因为a和b都是正整数,所以a-6和b-6也都是整数
所以现在有如下可能：（a和b可交换）
1、a-6=1,b-6=36； 解得a=7,b=42
2、a-6=2,b-6=18；解得a=8,b=24
3、a-6=3,b-6=12；解得a=9,b=18
4、a-6=4,b-6=9；解得a=10,b=15
5、a-6=6,b-6=6；解得a=12,b=12
于是六分之一可以写成：
1/6=1/7 + 1/42
1/6=1/8 + 1/24
1/6=1/9 + 1/18
1/6=1/10 + 1/15
1/6=1/12 + 1/12
就这五种可能（网上复制的，上面有链接）（第5组分母是相同的，如果要求分母不同的话则只有4组解）

把6换成其他整数n也可以这样做，当n为素数时候，分母不相同的只有唯一的一组解（当然分母是不相同的两个数），就是1/(n+1)+1/n(n+1).
例：1/7=1/8+1/56,1/5=1/6+1/30.

[此贴子已经被作者于2026-1-25 21:54编辑过]