|
|
楼主 |
发表于 2023-1-21 17:35
|
显示全部楼层
本帖最后由 ysr 于 2023-1-21 09:46 编辑
Private Sub Command1_Click()
Dim a, B, ak()
a = Trim(Text1)
a1 = 1
Do While a1 ^ 2 <= (a + 1) ^ 2 / 2
a2 = a ^ 2 - a1 ^ 2
If InStr(a2 ^ (1 / 2), ".") = 0 Then
js = js + 1
s2 = s2 & "/" & a & "^2=" & a1 & "^2+" & a2 ^ (1 / 2) & "^2" & vbCrLf
s13 = s13 & "/" & a1 ^ 2 & "/" & a2
Else
s13 = s13
End If
a1 = a1 + 1
Loop
s = "160225, 204425, 226525, 292825, 320450, 337025, 348725, 386425, 403325, 408850, 416585, 453050, 456025, 480675, 491725, 493025, 499525, 505325, 531505, 535925, 544765, 558025, 574925, 585650, 588965, 602225, 613275, 624325, 637325, 640900"
s4 = Split(s, ",")
j = UBound(s4)
For k = 1 To j
n1 = n1 + 1
ReDim Preserve ak(1 To n1)
ak(n1) = s4(n1)
s12 = s12 & "/" & Val(ak(n1)) ^ 2
Next
s12 = s12 & "/" & s13
s6 = paixu3(Trim(s12), Trim(s12))
s3 = paixu0(Trim(s12), Trim(s12))
's3 = "/" & s3
s5 = Split(s3, "/")
j1 = UBound(s5)
If js = 0 Then
Text2 = "有" & j1 & "组" & s3
Else
Text2 = "有" & j1 & "组" & s3 & "/平方数" & a & "^2的拆分解有:" & js & "组" & s2
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
Private Function paixu0(a As String, B As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f, bk()
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
s205 = Split(B, "/")
j1 = UBound(s105)
j2 = UBound(s205)
Print j1
For k = 1 To j1
n1 = n1 + 1
ReDim Preserve ak(1 To n1)
ak(n1) = s105(n1)
Next
For k = 1 To j2
n2 = n2 + 1
ReDim Preserve bk(1 To n2)
bk(n2) = s205(n2)
Next
n = 0
For k = 1 To j1
For i = 1 To j2
n = n + 1
ReDim Preserve cr(1 To n)
m = Val(ak(k)) + Val(bk(i))
f(m) = ""
If InStr(Sqr(Val(m)), ".") = 0 And Val(ak(k)) <> 0 And Val(bk(i)) <> 0 Then
s22 = s22 & "/" & m & "=" & m ^ (1 / 2) & "^2=" & Val(ak(k)) & "+" & Val(bk(i)) & "=" & Val(ak(k)) ^ (1 / 2) & "^2+" & Val(bk(i)) ^ (1 / 2) & "^2" & vbCrLf
Else
s22 = s22
End If
Next
Next
MsgBox "ok"
MsgBox s22 '显示数组
paixu0 = s22
End Function
Private Function paixu3(a As String, B As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f, bk()
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
s205 = Split(B, "/")
j1 = UBound(s105)
j2 = UBound(s205)
Print j1
For k = 1 To j1
n1 = n1 + 1
ReDim Preserve ak(1 To n1)
ak(n1) = s105(n1)
Next
For k = 1 To j2
n2 = n2 + 1
ReDim Preserve bk(1 To n2)
bk(n2) = s205(n2)
Next
n = 0
For k = 1 To j1
For i = 1 To j2
n = n + 1
ReDim Preserve cr(1 To n)
m = Val(ak(k)) + Val(bk(i))
f(m) = ""
Next
Next
n = 0
m = f.Keys
For i = 0 To j1
ReDim Preserve cr(1 To i + 1)
cr(i + 1) = m(i)
Next
For i = 1 To UBound(cr) - 1
For j = i + 1 To UBound(cr)
If cr(i) > cr(j) Then
temp = cr(j)
cr(j) = cr(i)
cr(i) = temp 'c数组是排序好的
End If
Next j
' If i Mod 20 = 0 Then
' s104 = s104 & temp & "/" & vbCrLf
' Else
' s104 = s104 & temp & "/"
' End If
Next i
For i = 1 To UBound(cr)
If i Mod 20 = 0 Then
s104 = s104 & cr(i) & "/" & vbCrLf
Else
s104 = s104 & cr(i) & "/"
End If
Next
Print temp
MsgBox "ok"
MsgBox s104 '显示数组
paixu3 = s104
End Function
|
|
IP卡
狗仔卡
显身卡