几个vb小程序

ysr

/7/1073741831/1073741833

ysr

Private Sub Command1_Click()
Dim a, B, c
a1 = Trim(Text1)
B1 = Val(Text2)
a1 = qxdcm(2, Trim(a1))
B = 1
Do While B <= Val(6)
s2 = 2
a = 2
Do While Val(s2) <= 2 * Val(B)
If InStr(Sqr(s2), ".") > 0 Then
s3 = 0
C2 = 4 * (B * (B + 1) - s2)
p = MPC1(Trim(C2), Trim(B1))
If Right(p, 1) Mod 2 = 0 Then
p = MPC1(Trim(p), 1)
Else
p = p
End If

Do While InStr(fenjieyinzi0(Trim(p)), "*") > 0 And s3 <= 3
s3 = s3 + 1
p = Val(p + 6)
Loop
Else
s2 = s2
End If

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
a = MPC1(Trim(a), 1)
s2 = Val(s2 + 1)
Loop
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

/2437/1073744261/1073744263
/3943/1073745767/1073745769
/15937/1125899906858561/1125899906858563
/16267/1125899906858891/1125899906858893
/38923/1152921504606885899/1152921504606885901

ysr

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

If Right(p, 1) Mod 2 = 0 Then
p = MPC1(Trim(p), 1)
Else
p = p
End If

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

If InStr(MCC(MPC1(Trim(a1), Trim(p)), 3), "/") > 0 Then
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
Else
p = p
End If
p = Val(p + 2)
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

/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这个数的循环节不能从小数点后直接算起，只能从点后第三位算起的。

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