如何把 1/7 拆分成四个不同单位分数的和，并且四个分母之和为最小？

ysr

这回终于有了这一组解：7  612  {8,120,154,330}
改变参数居然增加了这么多组解！
怀疑拆分解的个数是不是有限的？？

代码如下：

Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = Val(Text3)
a = Val(n)

Do While a >= Val(n) And a <= 6 * n
b = Val(a + 1)


Do While b <= Val(18 * n)
c = Val(b + 1)

Do While c <= Val(50 * n)

u = Val(a * b * c * n)
v = Val(a * b * c - n * (a * b + (a + b) * c))
If Val(v) > 0 Then
d = Val(u / v)

If c < d And u Mod Abs(v) = 0 Then
k = Val(a + b + c + d)
If k <= m Then
s = "{" & a & "," & b & "," & c & "," & d & "}"
s2 = s2 & n & "  " & k & "  " & s & vbCrLf
s3 = s3 + 1
End If
End If
End If

c = Val(c + 1)
Loop
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

ysr

输入：7和119
输出：无解

可见拆分成4个单位分数之和的分母的和的最小值就是120.

ysr

王守恩 发表于 2026-1-16 20:39
代码A是7#的代码。代码B速度会快一些。\(M=\infty\ 改\ M=24\)——就是根据3#来的。又：网友指出{2,43,{5,6 ...

修改后的程序结果仍然不是一组解？少了不少！

输入：7
输出：
7  168  {12,40,56,60}
7  158  {14,27,54,63}
7  168  {14,28,42,84}
7  163  {14,28,44,77}
7  156  {14,30,42,70}
7  152  {14,30,45,63}
7  145  {14,35,40,56}
7  155  {15,24,56,60}
7  162  {15,28,35,84}
7  145  {15,28,42,60}
7  150  {15,30,35,70}
7  141  {15,30,40,56}
7  144  {16,24,48,56}
7  134  {16,28,42,48}
7  164  {18,21,35,90}
7  159  {18,21,36,84}
7  144  {18,21,42,63}
7  134  {18,24,36,56}
7  124  {18,28,36,42}
7  155  {20,21,30,84}
7  136  {20,21,35,60}
7  130  {20,24,30,56}
7  120  {20,28,30,42}
7  129  {21,24,28,56}
7  120  {21,24,35,40}
解的个数为： 25组

需要比较大小，这次省力不少！

代码如下：

Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = Val(24 * n)
a = Val(n)

Do While a >= Val(n) And a <= 6 * n
b = Val(a + 1)


Do While b <= Val(18 * n)
c = Val(b + 1)

Do While c <= Val(50 * n)

u = Val(a * b * c * n)
v = Val(a * b * c - n * (a * b + (a + b) * c))
If Val(v) > 0 Then
d = Val(u / v)

If c < d And u Mod Abs(v) = 0 Then
k = Val(a + b + c + d)
If k <= m Then
s = "{" & a & "," & b & "," & c & "," & d & "}"
s2 = s2 & n & "  " & k & "  " & s & vbCrLf
s3 = s3 + 1
End If
End If
End If

c = Val(c + 1)
Loop
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

ysr

又改了一下程序，这回解更少了，仍然需要比较大小？

输入：7
输出：
7  158  {14,27,54,63}
7  168  {14,28,42,84}
7  163  {14,28,44,77}
7  155  {15,24,56,60}
7  162  {15,28,35,84}
7  145  {15,28,42,60}
7  144  {16,24,48,56}
7  134  {16,28,42,48}
7  164  {18,21,35,90}
7  159  {18,21,36,84}
7  144  {18,21,42,63}
7  134  {18,24,36,56}
7  124  {18,28,36,42}
7  155  {20,21,30,84}
7  136  {20,21,35,60}
7  130  {20,24,30,56}
7  120  {20,28,30,42}
7  129  {21,24,28,56}
7  120  {21,24,35,40}
解的个数为： 19组

ysr

输入：2
输出：
2  48  {4,8,12,24}
2  43  {5,6,12,20}
解的个数为： 2组
修改前：输入：2和10000
输出：
2  179  {4,6,13,156}
2  108  {4,6,14,84}
2  85  {4,6,15,60}
2  74  {4,6,16,48}
2  64  {4,6,18,36}
2  161  {4,7,10,140}
2  65  {4,7,12,42}
2  53  {4,7,14,28}
2  93  {4,8,9,72}
2  62  {4,8,10,40}
2  48  {4,8,12,24}
2  139  {5,6,8,120}
2  65  {5,6,9,45}
2  51  {5,6,10,30}
2  43  {5,6,12,20}
解的个数为： 15组

ysr

修改后的结果：
输入：8
输出：
8  186  {16,30,60,80}
8  192  {16,32,48,96}
8  192  {18,24,60,90}
8  189  {18,24,63,84}
8  171  {18,27,54,72}
8  165  {18,28,56,63}
8  178  {18,30,40,90}
8  165  {18,30,45,72}
8  182  {18,32,36,96}
8  176  {19,24,57,76}
8  185  {20,22,55,88}
8  191  {20,24,42,105}
8  179  {20,24,45,90}
8  172  {20,24,48,80}
8  169  {20,24,50,75}
8  165  {20,24,55,66}
8  185  {20,25,40,100}
8  158  {20,28,40,70}
8  178  {20,30,32,96}
8  171  {20,30,33,88}
8  158  {20,30,36,72}
8  150  {20,30,40,60}
8  148  {20,30,42,56}
8  171  {21,24,42,84}
8  166  {21,24,44,77}
8  177  {21,28,32,96}
8  170  {21,28,33,88}
8  157  {21,28,36,72}
8  149  {21,28,40,60}
8  147  {21,28,42,56}
8  181  {22,24,36,99}
8  156  {22,24,44,66}
8  179  {24,25,30,100}
8  141  {24,26,39,52}
8  141  {24,27,36,54}
8  152  {24,28,30,70}
8  135  {24,30,36,45}
解的个数为： 37组

ysr

王守恩 发表于 2026-1-16 20:39
代码A是7#的代码。代码B速度会快一些。\(M=\infty\ 改\ M=24\)——就是根据3#来的。又：网友指出{2,43,{5,6 ...

这回有了这一组解：
输入：2
输出：
2  48  {4,8,12,24}
2  43  {4,9,12,18}
2  41  {4,10,12,15}
2  43  {5,6,12,20}
解的个数为： 4组

代码如下：

Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = Val(24 * n)
a = Val(n)

Do While a >= Val(n) And a <= 5 * n
b = Val(a + 1)


Do While b <= Val(5 * n)
c = Val(b + 1)

Do While c <= Val(10 * n)

u = Val(a * b * c * n)
v = Val(a * b * c - n * (a * b + (a + b) * c))
If Val(v) > 0 Then
d = Val(u / v)

If c < d And u Mod Abs(v) = 0 Then
k = Val(a + b + c + d)
If k <= m Then
s = "{" & a & "," & b & "," & c & "," & d & "}"
s2 = s2 & n & "  " & k & "  " & s & vbCrLf
s3 = s3 + 1
End If
End If
End If

c = Val(c + 1)
Loop
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

ysr

8  190  {15,35,56,84}
8  185  {15,35,63,72}
8  183  {15,36,60,72}
8  190  {15,40,45,90}
8  183  {15,40,48,80}
8  180  {15,40,50,75}
8  176  {15,40,55,66}
8  186  {16,30,60,80}
8  192  {16,32,48,96}
8  185  {16,33,48,88}
8  177  {16,36,45,80}
8  172  {16,36,48,72}
8  164  {16,40,48,60}
8  176  {17,34,40,85}
8  192  {18,24,60,90}
8  189  {18,24,63,84}
8  171  {18,27,54,72}
8  165  {18,28,56,63}
8  178  {18,30,40,90}
8  165  {18,30,45,72}
8  182  {18,32,36,96}
8  175  {18,33,36,88}
8  156  {18,35,40,63}
8  154  {18,36,40,60}
8  152  {18,36,42,56}
8  176  {19,24,57,76}
8  185  {20,22,55,88}
8  191  {20,24,42,105}
8  179  {20,24,45,90}
8  172  {20,24,48,80}
8  169  {20,24,50,75}
8  165  {20,24,55,66}
8  185  {20,25,40,100}
8  158  {20,28,40,70}
8  178  {20,30,32,96}
8  171  {20,30,33,88}
8  158  {20,30,36,72}
8  150  {20,30,40,60}
8  148  {20,30,42,56}
8  141  {20,36,40,45}
8  171  {21,24,42,84}
8  166  {21,24,44,77}
8  177  {21,28,32,96}
8  170  {21,28,33,88}
8  157  {21,28,36,72}
8  149  {21,28,40,60}
8  147  {21,28,42,56}
8  138  {21,35,40,42}
8  181  {22,24,36,99}
8  156  {22,24,44,66}
8  179  {24,25,30,100}
8  141  {24,26,39,52}
8  141  {24,27,36,54}
8  152  {24,28,30,70}
8  135  {24,30,36,45}
解的个数为： 55组

ysr

7  158  {14,27,54,63}
7  168  {14,28,42,84}
7  163  {14,28,44,77}
7  156  {14,30,42,70}
7  152  {14,30,45,63}
7  145  {14,35,40,56}
7  155  {15,24,56,60}
7  162  {15,28,35,84}
7  145  {15,28,42,60}
7  150  {15,30,35,70}
7  141  {15,30,40,56}
7  144  {16,24,48,56}
7  134  {16,28,42,48}
7  164  {18,21,35,90}
7  159  {18,21,36,84}
7  144  {18,21,42,63}
7  134  {18,24,36,56}
7  124  {18,28,36,42}
7  155  {20,21,30,84}
7  136  {20,21,35,60}
7  130  {20,24,30,56}
7  120  {20,28,30,42}
7  129  {21,24,28,56}
7  120  {21,24,35,40}
解的个数为： 24组

ysr

代码已经修改为如下这样的：
Private Sub Command1_Click()
Dim n, a As Double
n = Val(Text1)
m = Val(24 * n)
a = Val(n)

Do While a >= Val(n) And a <= 5 * n
b = Val(a + 1)


Do While b <= Val(5 * n)
c = Val(b + 1)

Do While c <= Val(10 * n)

u = Val(a * b * c * n)
v = Val(a * b * c - n * (a * b + (a + b) * c))
If Val(v) > 0 Then
d = Val(u / v)

If c < d And u Mod Abs(v) = 0 Then
k = Val(a + b + c + d)
If k <= m Then
s = "{" & a & "," & b & "," & c & "," & d & "}"
s2 = s2 & n & "  " & k & "  " & s & vbCrLf
s3 = s3 + 1
End If
End If
End If

c = Val(c + 1)
Loop
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