|
|
楼主 |
发表于 2022-2-13 06:56
|
显示全部楼层
本帖最后由 ysr 于 2022-2-17 22:19 编辑
Private Sub Command1_Click()
'研究某数内最大间距的程序
Dim a, b
a = Val(Text1)
a1 = a
q = Val(Text2)
m = Sqr(q)
If Right(a, 1) Mod 2 = 0 Then
a = a + 1
Else
a = a
End If
s = 0
Do While a <= m
b = a + 2
c = fenjieyinzi0(Val(a))
d = fenjieyinzi0(Val(b))
If InStr(c, "*") = 0 Then
s = s + 1
If s Mod 2 = 0 Then
a3 = a
Else
a = a
End If
If a > 1000 Then
Print a, a3 - a
Else
a = a
End If
ja = ja & "/" & a
Else
s = s
End If
a = a + 2
Loop
a2 = a
s1 = s
Do While a2 <= q
B1 = a2 + 2
C1 = fenjieyinzi0(Val(a2))
D1 = fenjieyinzi0(Val(B1))
If InStr(C1, "*") = 0 Then
s1 = s1 + 1
If s1 Mod 2 = 0 Then
a3 = a2
Else
a4 = a2
End If
If a2 > 1800 Then
Print a2, a3 - a2, a2 - a4
Else
a2 = a2
End If
ja = ja & "/" & a2
Else
s1 = s1
End If
a2 = a2 + 2
Loop
Text3 = ja
Combo1 = a1 & "与" & q & "之间有" & s1 & "个素数:" & vbCrLf & Text3
s103 = ja
s103 = Mid(s103, 1)
Dim i As Integer
Dim ak(), s105, cr(), f
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)
n = 0
For i = 1 To j1 - 1
n = n + 1
ReDim Preserve cr(1 To n)
m = Val(ak(i + 1)) - Val(ak(i))
f(m) = ""
If m = 2 Then
js = js + 1
Else
If m = 4 Then
js1 = js1 + 1
Else
If m = 6 Then
js2 = js2 + 1
Else
If m = 8 Then
js3 = js3 + 1
Else
If m = 10 Then
js4 = js4 + 1
Else
If m = 12 Then
js5 = js5 + 1
Else
If m = 14 Then
js6 = js6 + 1
Else
If m = 16 Then
js7 = js7 + 1
Else
If m = 18 Then
js8 = js8 + 1
Else
If m = 20 Then
js9 = js9 + 1
Else
If m = 22 Then
js10 = js10 + 1
Else
If m = 24 Then
js11 = js11 + 1
Else
If m = 72 Then
s106 = s106 & "/" & Val(ak(i + 1))
js12 = js12 + 1
Else
m = m
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
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 '显示数组
Text4 = a1 & "~" & q & "内的素数间隔" & s104 & "差2=" & js & " 差4=" & js1 & " 差6=" & js2 & " 差8的=" & js3 & " 差10的=" _
& js4 & " 差12=" & js5 & " 差14=" & js6 & " 差16=" & js7 & " 差18=" & js8 & " 差20=" & js9 & " 差22=" & js10 _
& " 差24=" & js11 & " 差72的=" & js12 & "差72的是" & s106
End Sub |
|
[复制链接]
IP卡
狗仔卡
显身卡