数学中国

 找回密码
 注册
搜索
热搜: 活动 交友 discuz
楼主: ysr

几个vb小程序

[复制链接]
 楼主| 发表于 2023-2-27 06:39 | 显示全部楼层
/1 /73786976357262128867/73786976357262128869
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-1 23:33 | 显示全部楼层
本帖最后由 ysr 于 2023-3-2 00:58 编辑

Private Function paixu(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   j2 = Val(j1)
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     n = 0
        For k = 1 To j1
           For i = 1 To j1
             n = n + 1
             ReDim Preserve cr(1 To n)
            m = Val(ak(k)) + Val(ak(i))
            f(m) = ""
      Next
    Next
      n = 0
      
      m = f.Keys
      For i = 0 To j2
          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  '显示数组
     paixu = s104
End Function

Private Function paixu1(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     
        For k = 1 To j1
           
             ReDim Preserve cr(1 To k)
            m = Val(ak(k))
            f(m) = ""
      Next
   
      n = 0
      m = f.Keys
      For i = 0 To f.Count - 1
          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  '显示数组
     paixu1 = s104
End Function




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)
   j3 = Val(2000)
   If Val(j1) > 2000 Then
   j1 = j3
   Else
   j1 = j1
   End If
   
   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
    Print ak(1)
     n = 0
        For k = 1 To j1
           For i = 1 To j1
             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 j3
          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  '显示数组
     paixu0 = s104
End Function

Private Function fenjieyinzi(sa As String) As String
Dim X, a, B
X = sa
B = Int(Sqr(Val(X)) / 2)
If X = 3 Or X = 2 Then
a = True
Else
If Right(X, 1) Mod 2 = 0 Then
a = False
Else

For i = 3 To 2 * B + 1 Step 2
If InStr(X / i, ".") = 0 Then
a = False
Exit For

Else: a = True

End If
Next
End If
End If
If a = True Then
fenjieyinzi = "这是个素数"
Else
fenjieyinzi = "2*2"
End If

End Function



Private Sub Command1_Click()

'李明波幂和猜想的验证程序
Dim a, B, s2, js()
a = Val(1)
B = Val(Text1)
a1 = Val(a)
ja1 = 2
Do While a1 <= B And a1 ^ ja1 <= B

s2 = s2 & "/" & a1 ^ ja1

's3 = s3 & "/" & a1 ^ 3

's5 = s5 & "/" & a1 ^ 5

's6 = s6 & "/" & a1 ^ 7
's7 = s7 & "/" & a1 ^ 11
's8 = s8 & "/" & a1 ^ 13
's9 = s9 & "/" & a1 ^ 17
ja2 = 3
ReDim js(1 To B)
Do While ja2 < B And a1 ^ ja2 <= B

If InStr(fenjieyinzi(Val(ja2)), "*") = 0 Then
js(ja2) = a1 ^ ja2
js1 = js1 & "/" & js(ja2)
Else
js1 = js1
End If
ja2 = ja2 + 1
Loop


a1 = a1 + 1
Loop
Dim ak(), cr()

s10 = js1 & s2 & s5 & s6 & s7 & s8 & s9 & s3

s11 = paixu1(Trim(s10))
s11 = "/" & Mid(s11, 1, Len(s11) - 1)


a = Val(Text1)
jb = Val(Text1)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
s105 = Split(s11, "/")
j1 = UBound(s105)
For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    k = 1
    Do While k <= j1
    a3 = Abs(Val(a) - Val(ak(k))): a2 = 2: q = Sqr(Val(a3))
    Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q
a2 = Val(a2 + 1)
Loop

r = Log(a3) / Log(a2)
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "= " & a2 & "^" & r & "+" & ak(k) & vbCrLf
Else
a3 = a3
End If
   
    k = Val(k + 1)
    Loop
If InStr(Trim(Text2), "^") = 0 Then
Text2 = "wu  jie"
Else
Text2 = Text2
End If

End If

a = a + 1
Loop

End Sub

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

End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-2 00:25 | 显示全部楼层
505= 21^2+64
505= 19^2+144
505= 17^2+216
505= 6^3+289
505= 12^2+361
505= 2^6+441
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-2 00:35 | 显示全部楼层
103= 7^2+54
103= 3^3+76
103= 2^1+101
Private Function paixu(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   j2 = Val(j1)
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     n = 0
        For k = 1 To j1
           For i = 1 To j1
             n = n + 1
             ReDim Preserve cr(1 To n)
            m = Val(ak(k)) + Val(ak(i))
            f(m) = ""
      Next
    Next
      n = 0
      
      m = f.Keys
      For i = 0 To j2
          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  '显示数组
     paixu = s104
End Function
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-2 04:03 | 显示全部楼层
本帖最后由 ysr 于 2023-3-1 20:17 编辑

25887= -2^4+25903
25887=- 89^2+33808
不行出现负值了。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-2 04:16 | 显示全部楼层
本帖最后由 ysr 于 2023-3-2 02:30 编辑

25903= 154^2+2187
25903= 138^2+6859
25903= 19^3+19044
25903= 3^7+23716
2187=3^7
25887=-2^4+25903=-2^4+154^2+2187=-2^4+154^2+3^7

修改程序后的结果:25887 = wu  jie
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-2 04:24 | 显示全部楼层
本帖最后由 ysr 于 2023-3-2 02:28 编辑

Private Sub Command1_Click()

'李明波幂和猜想的验证程序,修改一下
Dim a, B, s2, js()
a = Val(1)
B = Val(Text1)
a1 = Val(a)
ja1 = 2
Do While a1 <= B And a1 ^ ja1 <= B

s2 = s2 & "/" & a1 ^ ja1

's3 = s3 & "/" & a1 ^ 3

's5 = s5 & "/" & a1 ^ 5

's6 = s6 & "/" & a1 ^ 7
's7 = s7 & "/" & a1 ^ 11
's8 = s8 & "/" & a1 ^ 13
's9 = s9 & "/" & a1 ^ 17
ja2 = 3
ReDim js(1 To B)
Do While ja2 < B And a1 ^ ja2 <= B

If InStr(fenjieyinzi(Val(ja2)), "*") = 0 Then
js(ja2) = a1 ^ ja2
js1 = js1 & "/" & js(ja2)
Else
js1 = js1
End If
ja2 = ja2 + 1
Loop


a1 = a1 + 1
Loop
Dim ak(), cr()

s10 = js1 & s2 & s5 & s6 & s7 & s8 & s9 & s3

s11 = paixu1(Trim(s10))
s11 = "/" & Mid(s11, 1, Len(s11) - 1)


a = Val(Text1)
jb = Val(Text1)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
s105 = Split(s11, "/")
j1 = UBound(s105)
For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    k = 1
    Do While k < j1 And Val(a) > Val(ak(k))
    a3 = Abs(Val(a) - Val(ak(k))): a2 = 2: q = Sqr(Val(a3))
    Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q
a2 = Val(a2 + 1)
Loop

r = Log(a3) / Log(a2)
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "= " & a2 & "^" & r & "+" & ak(k) & vbCrLf
Else
a3 = a3
End If
   
    k = Val(k + 1)
    Loop
If InStr(Trim(Text2), "^") = 0 Then
Text2 = "wu  jie"
Else
Text2 = Text2
End If

End If

a = a + 1
Loop

End Sub

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

End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-10 17:20 | 显示全部楼层
Private Sub Command1_Click()

'李明波幂和猜想的验证程序,修改一下
Dim a, B, s2, js()
a = Val(1)
B = Val(Text1)
a1 = Val(a)
ja1 = 2
Do While a1 <= B And a1 ^ ja1 <= B

s2 = s2 & "/" & a1 ^ ja1

's3 = s3 & "/" & a1 ^ 3

's5 = s5 & "/" & a1 ^ 5

's6 = s6 & "/" & a1 ^ 7
's7 = s7 & "/" & a1 ^ 11
's8 = s8 & "/" & a1 ^ 13
's9 = s9 & "/" & a1 ^ 17
ja2 = 3
ReDim js(1 To B)
Do While ja2 < B And a1 ^ ja2 <= B

If InStr(fenjieyinzi(Val(ja2)), "*") = 0 Then
js(ja2) = a1 ^ ja2
js1 = js1 & "/" & js(ja2)
Else
js1 = js1
End If
ja2 = ja2 + 1
Loop


a1 = a1 + 1
Loop
Dim ak(), cr()

s10 = js1 & s2 & s5 & s6 & s7 & s8 & s9 & s3

s11 = paixu1(Trim(s10))
s11 = "/" & Mid(s11, 1, Len(s11) - 1)


a = Val(Text1)
jb = Val(Text1)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
s105 = Split(s11, "/")
j1 = UBound(s105)
For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    k = 1
    Do While k < j1 And Val(a) > Val(ak(k))
    a3 = Abs(Val(a) - Val(ak(k))): a2 = 2: q = Sqr(Val(a3))
    Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q
a2 = Val(a2 + 1)
Loop

r = Log(a3) / Log(a2)
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "= " & a2 & "^" & r & "+" & paixu11(Trim(ak(k)), Trim(jb)) & vbCrLf
Else
a3 = a3
End If
   
    k = Val(k + 1)
    Loop
If InStr(Trim(Text2), "^") = 0 Then
Text2 = "wu  jie"
Else
Text2 = Text2
End If

End If

a = a + 1
Loop

End Sub

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

End Sub

Private Function paixu11(a3 As String, q As String) As String
a2 = Val(2)
Do While InStr(Val(Log(a3) / Log(a2)), ".") > 0 And a2 <= Val(q)
a2 = Val(a2) + 1
Loop

r = Log(a3) / Log(a2)
paixu11 = a2 & "^" & r
End Function


Private Function paixu(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   j2 = Val(j1)
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     n = 0
        For k = 1 To j1
           For i = 1 To j1
             n = n + 1
             ReDim Preserve cr(1 To n)
            m = Val(ak(k)) + Val(ak(i))
            f(m) = ""
      Next
    Next
      n = 0
      
      m = f.Keys
      For i = 0 To j2
          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  '显示数组
     paixu = s104
End Function

Private Function fenjieyinzi(sa As String) As String
Dim X, a, B
X = sa
B = Int(Sqr(Val(X)) / 2)
If X = 3 Or X = 2 Then
a = True
Else
If Right(X, 1) Mod 2 = 0 Then
a = False
Else

For i = 3 To 2 * B + 1 Step 2
If InStr(X / i, ".") = 0 Then
a = False
Exit For

Else: a = True

End If
Next
End If
End If
If a = True Then
fenjieyinzi = "这是个素数"
Else
fenjieyinzi = "2*2"
End If

End Function


Private Function paixu1(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     
        For k = 1 To j1
           
             ReDim Preserve cr(1 To k)
            m = Val(ak(k))
            f(m) = ""
      Next
   
      n = 0
      m = f.Keys
      For i = 0 To f.Count - 1
          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  '显示数组
     paixu1 = s104
End Function

回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-10 17:42 | 显示全部楼层
本帖最后由 ysr 于 2023-3-10 09:43 编辑

25888= 132^2+92^2
25888= 92^2+132^2
25887=无解
25883= 139^2+6562
25883= 3^8+19322

6562=81^2+1
19322=139^2+1
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-3-10 17:44 | 显示全部楼层
Private Sub Command1_Click()

'李明波幂和猜想的验证程序,修改一下
Dim a, B, s2, js()
a = Val(1)
B = Val(Text1)
a1 = Val(a)
ja1 = 2
Do While a1 <= B And a1 ^ ja1 <= B

s2 = s2 & "/" & a1 ^ ja1

's3 = s3 & "/" & a1 ^ 3

's5 = s5 & "/" & a1 ^ 5

's6 = s6 & "/" & a1 ^ 7
's7 = s7 & "/" & a1 ^ 11
's8 = s8 & "/" & a1 ^ 13
's9 = s9 & "/" & a1 ^ 17
ja2 = 3
ReDim js(1 To B)
Do While ja2 < B And a1 ^ ja2 <= B

If InStr(fenjieyinzi(Val(ja2)), "*") = 0 Then
js(ja2) = a1 ^ ja2
js1 = js1 & "/" & js(ja2)
Else
js1 = js1
End If
ja2 = ja2 + 1
Loop


a1 = a1 + 1
Loop
Dim ak(), cr()

s10 = js1 & s2 & s5 & s6 & s7 & s8 & s9 & s3

s11 = paixu1(Trim(s10))
s11 = "/" & Mid(s11, 1, Len(s11) - 1)
s11 = paixu(Trim(s11))

a = Val(Text1)
jb = Val(Text1)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text2 = Text2 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
s105 = Split(s11, "/")
j1 = UBound(s105)
For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    k = 1
    Do While k < j1 And Val(a) > Val(ak(k))
    a3 = Abs(Val(a) - Val(ak(k))): a2 = 2: q = Sqr(Val(a3))
    Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q
a2 = Val(a2 + 1)
Loop

r = Log(a3) / Log(a2)
If InStr(r, ".") = 0 Then
Text2 = Text2 & a & "= " & a2 & "^" & r & "+" & Trim(ak(k)) & vbCrLf
Else
a3 = a3
End If
   
    k = Val(k + 1)
    Loop
If InStr(Trim(Text2), "^") = 0 Then
Text2 = "wu  jie"
Else
Text2 = Text2
End If

End If

a = a + 1
Loop

End Sub

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

End Sub

Private Function paixu11(a3 As String, q As String) As String
a2 = Val(2)
Do While InStr(Val(Log(a3) / Log(a2)), ".") > 0 And a2 <= Val(q)
a2 = Val(a2) + 1
Loop

r = Log(a3) / Log(a2)
paixu11 = a2 & "^" & r
End Function


Private Function paixu(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   j2 = Val(j1)
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     n = 0
        For k = 1 To j1
           For i = 1 To j1
             n = n + 1
             ReDim Preserve cr(1 To n)
            m = Val(ak(k)) + Val(ak(i))
            f(m) = ""
      Next
    Next
      n = 0
      
      m = f.Keys
      For i = 0 To j2
          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  '显示数组
     paixu = s104
End Function
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|数学中国 ( 京ICP备05040119号 )

GMT+8, 2024-3-28 20:05 , Processed in 0.069335 second(s), 15 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表