'原理和公式见《数学中国论坛》上蔡家雄的文章
'4/p=1/x+1/y+1/z
Private Sub Command1_Click()
Dim k, m, t1, t2, p, a
Dim w As Double
a = Val(Text1)
k = 1
Do While k <= a
m = 1
Do While m <= a
d = (15 * k + 13) * m + 11 * k + 9
p = 120 * d + 49
d1 = fenjieyinzi(Val(p))
If InStr(d1, "*") = 0 Then
w = (120 * d + 49) * (30 * d + 16)
t1 = 30 * k + 26
t2 = (30 * d + 16) ^ 2 / (30 * k + 26)

If InStr(t2, ".") = 0 And (w - 4) / 15 - Int((w - 4) / 15) = 0 And (t1 - 11) / 15 - Int((t1 - 11) / 15) = 0 And (t2 - 11) / 15 - Int((t2 - 11) / 15) = 0 Then
x = 30 * d + 16: y = (w + t2) / 15: z = (w + t1 * (120 * d + 49) ^ 2) / 15
If InStr(y, ".") = 0 And InStr(z, ".") = 0 Then
's = s & "w=" & w & "  d=" & d & " t1=" & t1 & " t2=" & t2 & vbCrLf
s = s & "p=120d+49= " & p & "  x=" & x & "  y=" & y & "  z=" & z & vbCrLf
s1 = s1 + 1
End If
End If
End If
m = m + 1
Loop

k = k + 1
Loop
If s1 > 0 Then
Text2 = "k和m在" & a & "内，有" & s1 & "组解：" & vbCrLf & s
Else
Text2 = "wu  jie"
End If


End Sub

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

End Sub

Private Function fenjieyinzi(sa As String) As String
Dim x, a, b, k As String
a = Val(sa)

x = 3
If a <= 1 Or a > Int(a) Then
If a = 1 Then
fenjieyinzi = "它既不是质数，也不是合数"

Else
MsgBox "error"
End If
  
Else

Do While a / 2 = Int(a / 2) And a >= 4
  
If b = 0 Then
fenjieyinzi = fenjieyinzi & "2"
b = 1
Else
fenjieyinzi = fenjieyinzi & "*2"
End If
a = a / 2
k = a
  
Loop

Do While a > 1
Do While x <= Sqr(a)
Do While a / x = Int(a / x) And a >= x * x
  
If b = 0 Then
fenjieyinzi = fenjieyinzi & x
b = 1
Else
fenjieyinzi = fenjieyinzi & "*" & x
End If
a = a / x
Loop
  
x = x + 2
Loop
  
k = a
a = 1
Loop
  
If b = 1 Then
fenjieyinzi = fenjieyinzi & "*" & k
Else
fenjieyinzi = "这是一个质数"
End If

End If

End Function