几个vb小程序

ysr

/38923/1152921504606885899/1152921504606885901
/41281/1152921504606888257/1152921504606888259
/48121/1152921504606895097/1152921504606895099

ysr

Private Sub Command1_Click()
Dim a, B, c
a1 = Trim(Text1)
B1 = Val(Text2)
p = B1
p = Int(p / 6) * 6 + 1
a1 = qxdcm(2, Trim(a1))
B = 1
Do While B <= Val(100)


Do While InStr(fenjieyinzi0(Trim(p)), "*") > 0
p = Val(p + 6)
Loop

p1 = MPC1(Trim(p), Trim(a1))
p2 = MPC1(Trim(p1), 2)
If InStr(fenjieyinzi0(Trim(p)), "*") = 0 And InStr(fenjieyinzi0(Trim(p1)), "*") = 0 And InStr(fenjieyinzi0(Trim(p2)), "*") = 0 Then
s = s & "/" & p & "/" & p1 & "/" & p2 & vbCrLf
s1 = s1 + 1
Else
s1 = s1
End If

p = Val(p + 6)
B = Val(B + 1)
Loop

If s1 > 0 Then
Text3 = s
Else
Text3 = "无解"
End If
End Sub

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

Private Function qxdcm(sa As String, sb As String) As String

Dim a, B
a = sa: B = sb
If B = 1 Then
qxdcm = a
ElseIf B = 0 Then
qxdcm = 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
qxdcm = MbC(Trim(a3), Trim(a1))
Else
qxdcm = a3
End If

End If

End Function

ysr

#保存一下这个python程序：

a=[1,2,3]
b=[a]*5
print(b)

ysr

Private Sub Command1_Click()
Dim a, b
a = Val(Text1)
b = tuzis(Val(a))

Text2 = b

End Sub

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

End Sub

Public Function tuzis(sa As String) As String '兔子数列
Dim a, b, c
a = Val(sa)
b = 1
B1 = 0
b2 = 1
b3 = 0
Do While b <= a
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


b = Val(b + 1)

Loop
tuzis = s1

End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
D3 = D1
Else
D4 = D2
D3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(D3): y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim i, j, C2, CJ, JW
For j = y To 1 Step -1 'D2
JW = 0 '进位清0
B1(j) = Mid$(D4, j, 1) '每位数
For i = x To 1 Step -1  'D1
   a(i) = Mid$(D3, i, 1) '每位数
   C1(i) = a(i) + B1(i) + JW '计算jia
   JW = C1(i) \ 10
   E1(i) = C1(i) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function

ysr

Public Function tuzis(sa As String) As String 'jiafa
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 1 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MbC(Trim(A), Trim(B)), Trim(c))
  Y = MPC1(MbC(Trim(c), Trim(B)), Trim(A))
   z = MPC1(MbC(Trim(A), Trim(c)), Trim(B))
   If InStr(fenjieyinzi0(Trim(x)), "*") = 0 Or InStr(fenjieyinzi0(Trim(Y)), "*") = 0 Or InStr(fenjieyinzi0(Trim(z)), "*") = 0 Then
  s = s + 1
  If InStr(fenjieyinzi0(Trim(x)), "*") = 0 Then
  s1 = s1 & "/" & s & " /" & x & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(Y)), "*") = 0 Then
  s1 = s1 & "/" & s & " /" & Y & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(z)), "*") = 0 Then
  s1 = s1 & "/" & s & " /" & z & vbCrLf
  Else
  s = s
  End If
  End If
  Next
   

Text2 = s1

End Sub

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

End Sub

ysr

44.64   ÷   42 =1.0628571428571428571428571428571这个数的循环节不能从小数点后直接算起，只能从点后第三位算起的。

这类数有些时候循环节是不能从点后第一位算起而要从其他某位算起的。

ysr

Public Function tuzis(sa As String) As String 'jiafa
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
B1 = ksm2(Val(664))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 15 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MPC1(MbC(Trim(A), Trim(B)), Trim(c)), Trim(B1))
  Y = MPC1(MPC1(MbC(Trim(c), Trim(B)), Trim(A)), Trim(B1))
   z = MPC1(MPC1(MbC(Trim(A), Trim(c)), Trim(B)), Trim(B1))
   
  If InStr(fenjieyinzi0(Trim(x)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & x & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(Y)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & Y & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(z)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & z & vbCrLf
  Else
  s = s
  End If

  Next
   

Text2 = s1

End Sub

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

End Sub

ysr

/1 /76545051729020975577310162521900618820659871603466655644272117978380005723696097587725184512638784526308634214455061267843403507870735540391292521535824647434568377082591826884769598224146796862139607
兔子数列某3项由蔡氏法构成的数45771991（前面的1是序号）加上个大偶数形成的大素数，大约200位

ysr

Public Function tuzis(sa As String) As String 'tuzi shulie
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
B1 = ksm2(Val(664))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 18 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MPC1(MbC(Trim(A), Trim(B)), Trim(c)), Trim(B1))
  Y = MPC1(MPC1(MbC(Trim(c), Trim(B)), Trim(A)), Trim(B1))
   z = MPC1(MPC1(MbC(Trim(A), Trim(c)), Trim(B)), Trim(B1))
   
  If InStr(fenjieyinzi0(Trim(x)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & x & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(Y)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & Y & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(z)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & z & vbCrLf
  Else
  s = s
  End If

  Next
   
If s > 0 Then
Text2 = s1
Else
Text2 = "wu  jie"
End If
End Sub

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

End Sub

Private Function ksm2(sa As String) As String '2的快速幂程序
Dim A, B
A = Val(2): B = sa
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

ysr

2^664=有200位，用时0秒76545051729020975577310162521900618820659871603466655644272117978380005723696097587725184512638784526308634214455061267843403507870735540391292521535824647434568377082591826884769598224146796816367616