|
|
楼主 |
发表于 2026-9-23 12:49
|
显示全部楼层
本帖最后由 ysr 于 2026-9-23 06:08 编辑
可以给出KLG即乘以波动因子的连乘积结果的代码如下（能不能运行还不知道） ：
Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
b = Val(Text2)
If Right(a, 1) Mod 2 = 0 Then
a = a
Else
a = Val(a + 1)
End If
a1 = a
Do While a1 <= b
c = fenjieyinzi1(Val(a1))
c2 = fenjieyinzi2(Val(a1))
gl1 = (Val(a1)) ^ 0.5
g = Mid(c, InStr(c, "=") + 1)
sa = fenjieyinzi(Val(a1))
sa = "*" & Trim(sa)
sa = paixu1(Trim(sa))
k = paixu12(Trim(sa), Val(gl1))
lg = Mid(c2, InStr(c2, "=") + 1)
lg = Mid(lg, 1, InStr(lg, "而") - 1)
klg = Val(k) * Val(lg)
lg = Int(Val(lg))
c3 = Mid(c2, InStr(c2, "为") + 1, InStr(c2, ">") - 1)
m = Val(c3)
ls = fenjieyinzi3(Val(a1))
c1 = c1 & c & " /差为" & Val(g - lg) & "/" & c2 & vbCrLf & "实际区间平均值G/(m-1)为" & Val(g) / (Val(m) - 1) & " KLG=" & klg & vbCrLf & "小根拆：" & vbCrLf & ls
a1 = a1 + 2
Loop
Text3 = c1
jc = "（如下文字和数据中的小于＜和大于＞是代表尖括号，其中的斜杠/只有在“LG/(m-1)”中间的斜杠/是除号，其他都是间隔号）" & vbCrLf
Combo1 = jc & "偶数/ 方根/ GM/ G/差 G-LG/ 偶数/ P/ m/ <LG/(m-1)区间理论平均值>/ LG" & vbCrLf & c1
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""
Form1.Cls
End Sub
Private Function fenjieyinzi(sa As String) As String
Dim x, a, b, k As String
a = Val(sa)
x = 3
If a <= 1 Or a > Int(a) Then
If a = 1 Then
fenjieyinzi = "它既不是质数，也不是合数"
Else
MsgBox "error"
End If
Else
Do While a / 2 = Int(a / 2) And a >= 4
If b = 0 Then
fenjieyinzi = fenjieyinzi & "2"
b = 1
Else
fenjieyinzi = fenjieyinzi & "*2"
End If
a = a / 2
k = a
Loop
Do While a > 1
Do While x <= Sqr(a)
Do While a / x = Int(a / x) And a >= x * x
If b = 0 Then
fenjieyinzi = fenjieyinzi & x
b = 1
Else
fenjieyinzi = fenjieyinzi & "*" & x
End If
a = a / x
Loop
x = x + 2
Loop
k = a
a = 1
Loop
If b = 1 Then
fenjieyinzi = fenjieyinzi & "*" & k
Else
fenjieyinzi = "这是一个质数"
End If
End If
End Function
Private Function fenjieyinzi1(sa As String) As String
Dim a, b
a = Val(sa)
m = Sqr(a)
a1 = 3
s = 0
Do While a1 <= m
b = a - a1
c = fenjieyinzi(Val(a1))
d = fenjieyinzi(Val(b))
If InStr(c, "*") = 0 And InStr(d, "*") = 0 Then
s = s + 1
Print a1, "+", b
'ls2 = ls2 & CStr(a1) & "+ " & CStr(b) & vbCrLf
Else
s = s
End If
a1 = a1 + 2
Loop
a2 = a1
s1 = s
Do While a2 <= a / 2
b1 = a - a2
c1 = fenjieyinzi(Val(a2))
d1 = fenjieyinzi(Val(b1))
If InStr(c1, "*") = 0 And InStr(d1, "*") = 0 Then
s1 = s1 + 1
Print a2, "+", b1
'ls2 = ls2 & CStr(a2) & "+ " & CStr(b1) & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2
Loop
fenjieyinzi1 = a & "/方根" & m & "/GM是" & s & " / G=" & s1
End Function
Private Function fenjieyinzi2(sa As String) As String
Dim a, b
a = Val(sa)
m = Sqr(a)
m1 = Int(m)
a2 = m1
a1 = 3
s = 1
b = 1
Do While a2 <= m And InStr(fenjieyinzi(Val(a2)), "*") <> 0
a2 = a2 - 1
Loop
Do While a1 <= a2
c = fenjieyinzi(Val(a1))
If InStr(Trim(c), "*") = 0 Then
s = s + 1
b = b * Val(1 - 2 / a1)
Else
s = s
End If
a1 = a1 + 2
Loop
b2 = (a2 ^ 2 / 4) * b
b1 = (a / 4) * b
s1 = s
Do While a1 <= 4 * a2
c = fenjieyinzi(Val(a1))
If InStr(Trim(c), "*") = 0 Then
s1 = s1 + 1
b = b * Val(1 - 2 / a1)
Else
s1 = s1
End If
a1 = a1 + 2
Loop
b3 = (a / 4) * b
If s = 1 Then
fenjieyinzi2 = " /" & a & " /" & a2 & " /m为" & s & "> 区间的理论平均值LG/(m-1)为" & b2 / s - 1 & " LG=" & b1 & "而CLG是" & b3
Else
fenjieyinzi2 = " /" & a & " /" & a2 & " /<m为" & s & "> 区间的理论平均值LG/(m-1)为" & b2 / (s - 1) & " LG=" & b1 & "而CLG是" & b3
End If
End Function
Private Function fenjieyinzi3(sa As String) As String
Dim a, b
a = Val(sa)
m = Sqr(a)
a1 = 3
s = 0
Do While a1 <= m
b = a - a1
c = fenjieyinzi(Val(a1))
d = fenjieyinzi(Val(b))
If InStr(c, "*") = 0 And InStr(d, "*") = 0 Then
s = s + 1
Print a1, "+", b
ls2 = ls2 & CStr(a1) & "+ " & CStr(b) & vbCrLf
Else
s = s
End If
a1 = a1 + 2
Loop
a2 = a1
s1 = s
Do While a2 <= a / 2
b1 = a - a2
c1 = fenjieyinzi(Val(a2))
d1 = fenjieyinzi(Val(b1))
If InStr(c1, "*") = 0 And InStr(d1, "*") = 0 Then
s1 = s1 + 1
Print a2, "+", b1
'ls2 = ls2 & CStr(a2) & "+ " & CStr(b1) & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2
Loop
fenjieyinzi3 = ls2
End Function
Private Function paixu12(a As String, sb As String) As String
Dim i As Integer
Dim ak(), s105, cr(), k
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
j1 = UBound(s105)
Print j1
k = 1
For k1 = 1 To j1
n1 = n1 + 1
ReDim Preserve ak(1 To n1)
ak(n1) = s105(n1)
k2 = ak(n1)
Print ak(n1)
If k2 <> 2 And k2 < Val(sb) Then
k = k * (k2 - 1) / (k2 - 2)
Else
k = k
End If
Next
paixu12 = k
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)
Print ak(n1)
Next
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
|
|
IP卡
狗仔卡
显身卡