|
|
楼主 |
发表于 2021-7-28 21:05
|
显示全部楼层
代码如下：（仅发主程序，数据再大就溢出了，还需要修改）
Private Sub Command1_Click()
Dim a, b, x, y, z, m
m1 = Text1
m = Text2
t = Timer
B1 = m / 2
b = 0
s1 = 0
Do While b < Val(B1) + 2
a = 0
b = b + 1
Print b
Do While a < Val(m)
a = a + 2
z = 4 * Val(ksm2(Val(b), Val(15)))
y = 3 * Val(a) ^ 5
x = MBBC1(zhengchuqy(MCC1(Val(z - y), 2)))
If InStr(x, "/") = 0 And x <> 0 Then
s = s & "/解/" & x & "/" & a & "/" & b & vbCrLf
s1 = s1 + 1
Else
s = s
End If
Loop
Loop
Text3 = Text3 & "当y<=" & m & "有" & s1 & "组解： " & s
Combo1 = Text3 & "用时" & Timer - t & "秒"
End Sub
Private Function ksm2(sa As String, sb As String) As String '2的快速幂程序
Dim a, b
a = Val(sa): b = sb
If b = 1 Then
ksm2 = a
ElseIf b = 0 Then
ksm2 = 1
Else
a1 = a
Do While b > 1
s = Int(Log(b) / Log(2))
s1 = 0
Do While s1 < s
a = MbC(Trim(a), Trim(a))
s1 = s1 + 1
Loop
a2 = a
b = b - 2 ^ s
a = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If b = 1 Then
ksm2 = MbC(Trim(a3), Trim(a1))
Else
ksm2 = a3
End If
s3 = Len(ksm2)
ksm2 = ksm2
End If
End Function
Public Function MBBC1(D1 As String) As String 'kai lifang
If Len(D1) < 10 Then
jss = Int((D1) ^ (1 / 3))
If (Val(jss) + 1) ^ 3 - Val(D1) = 0 Then
jss = Val(jss) + 1
Else
jss = jss
End If
JW = Val(D1) - (jss) ^ 3
If JW = 0 Then
MBBC1 = jss
Else
MBBC1 = jss & "/" & JW
End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 3
D2 = String(3 - Len(D1) + 3 * x, "0") & D1
Dim a() As String
ReDim a(3 To 3 * x + 3)
Dim b() As String
ReDim b(1 To x)
Dim i, j, js
For i = 3 To 3 * x + 3 Step 3
a(i) = Mid(D2, i - 2, 3)
Next
js = Int((Val(a(3) & a(6))) ^ (1 / 3))
If (Val(js) + 1) ^ 3 - Val(a(3) & a(6)) = 0 Then
js = Val(js) + 1
Else
js = js
End If
JW = Val(a(3) & a(6)) - (js) ^ 3
j = 2
Do While j <= x
jws = MPC1(JW & "000", a(3 * j + 3))
If MBJC(Trim(jws), MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1)) < 0 Then
b(j) = "0"
Else
jwc = Left(jws, 2) \ Left(MPC1(MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), 1)), 3), 1), 1) '2=Len(jws) - Len(MbC(MbC(Trim(js), MPC1(Trim(js), 1)), 30)) + 1
If Len(jwc) > 1 Then
b(j) = 9
Else
b(j) = jwc
End If
Do While MBJC(Trim(jws), MbC(MPC1(MbC(b(j), b(j)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(b(j)))), 3)), b(j))) = -1
b(j) = b(j) - 1
Loop
End If
JW = MPC(Trim(jws), MbC(MPC1(MbC(b(j), b(j)), MbC(MbC(MbC(Trim(js), 10), MPC1(MbC(Trim(js), 10), Trim(b(j)))), 3)), b(j)))
js = MPC1(MbC(Trim(js), 10), Trim(b(j)))
j = j + 1
If JW = 0 Then
MBBC1 = js
Else
MBBC1 = js & "/" & JW
End If
Loop
End If
End Function
|
|
IP卡
狗仔卡
显身卡
发表于 2021-7-28 21:06