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 Sub Command1_Click()
Dim a, b
a = Val(Text1)
q = Val(Text3)
Do While a <= q
s = 0
m = Sqr(a)
a1 = 3
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
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
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 Sub Command1_Click()
Dim a, b
a = Val(Text1)
q = Val(Text3)
Do While a <= q
s = 0
m = Sqr(a)
a1 = 3
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
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
ArcTan:
VB自带：Atn
ArcSin:
Function ArcSin(X As Doule) As Double
Dim Temp As Double
If X = 0 Then
Temp=0
Else
Temp = Atn(X/Sqr(1-X*X))
End If
ArcSin=Temp
End Function
ArcCos:
Function ArcCos(X As Doule) As Double
Dim Temp As Double
If X = 0 Then
Temp=pi/2
Else
Temp = Atn(Sqr(1-X*X)/X)
End If
ArcCos=Temp
End Function
'Secant
Public Function Sec(ByVal Number As Double) As Double
Sec = 1 / Cos(Number)
End Function作者: ysr 时间: 2021-2-9 20:36 本帖最后由 ysr 于 2021-2-9 12:54 编辑
在vb中。如何进行三角函数的程序代码编写
有几个地方要注意：
1、VB中的三角函数的角度全部是用弧度制表示的，如果是度数的话，应先乘以π再除以180转成弧度，再用函数计算结果。
2、VB中直接支持的三角函数有：Sin()、Cos()、Tan()，如果涉及到其它三角函数，可以从下面列出的代码中自己选择相应的函数：
Function Sec(X) As Double '正割
Sec = 1 / Cos(Angle)
End Function
Function Csc(X) As Double '余割
Csc = 1 / Sin(Angle)
End Function
Function Cot(X) As Double '余切
Cot = 1 / Tan(Angle)
End Function
Function ArcSin(X) As Double '反正弦
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function
Function ArcCos(X) As Double '反余弦
ArcCos = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
End Function
Function ArcSec(X) As Double '反正割
ArcSec = Atn(X / Sqr(X * X - 1)) + Sgn((X) - 1) * (2 * Atn(1))
End Function
Function ArcCsc(X) As Double '反余割
ArcCsc = Atn(X / Sqr(X * X - 1)) + (Sgn(X) - 1) * (2 * Atn(1))
End Function
Function ArcCot(X) As Double '反余切
ArcCot = Atn(X) + 2 * Atn(1)
End Function
Function HSin(X) As Double '双曲正弦
HSin = (Exp(X) - Exp(-X)) / 2
End Function
Function HCos(X) As Double '双曲余弦
HCos = (Exp(X) + Exp(-X)) / 2
End Function
Function HTan(X) As Double '双曲正切
HTan = (Exp(X) - Exp(-X)) / (Exp(X) + Exp(-X))
End Function
Function HSec(X) As Double '双曲正割
HSec = 2 / (Exp(X) + Exp(-X))
End Function
Function HCsc(X) As Double '双曲余割
HCsc = 2 / (Exp(X) - Exp(-X))
End Function
Function HCot(X) As Double '双曲余切
HCot = (Exp(X) + Exp(-X)) / (Exp(X) - Exp(-X))
End Function
Function HArcsin(X) As Double '反双曲正弦
HArcsin = Log(X + Sqr(X * X + 1))
End Function
Function HArccos(X) As Double '反双曲余弦
HArccos = Log(X + Sqr(X * X - 1))
End Function
Function HArctan(X) As Double '反双曲正切
HArctan = Log((1 + X) / (1 - X)) / 2
End Function
Function HArcsec(X) As Double '反双曲正割
HArcsec = Log((Sqr(-X * X + 1) + 1) / X)
End Function
Function HArccsc(X) As Double '反双曲余割
HArccsc = Log((Sgn(X) * Sqr(X * X + 1) + 1) / X)
End Function
Function HArccot(X) As Double '反双曲余切
HArccot = Log((X + 1) / (X - 1)) / 2
End Function作者: ysr 时间: 2021-2-9 20:39 本帖最后由 ysr 于 2021-2-9 12:41 编辑
Option Explicit
Const pi = "3.141592653589793238462"
Dim x As Double, y As Double
Private Sub Form_Load()
Option1.Value = True
End Sub
Private Sub Command1_Click()
Dim x As Double, y As Double
Dim asin As Double
x = Val(Text1.Text)
If Option1 = True Then
x = Val(x * pi / 180)
Else
x = x
End If
y = Sin(x)
Text2 = y
End Sub
Function Sec(x) As Double '正割
Sec = 1 / Cos(x)
End Function
Function Csc(x) As Double '余割
Csc = 1 / Sin(x)
End Function
Function Cot(x) As Double '余切
Cot = 1 / Tan(x)
End Function
Function ArcSin(x) As Double '反正弦
ArcSin = Atn(x / Sqr(-x * x + 1))
End Function
Function ArcCos(x) As Double '反余弦
ArcCos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
Function ArcSec(x) As Double '反正割
ArcSec = Atn(x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
End Function
Function ArcCsc(x) As Double '反余割
ArcCsc = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
End Function
Function ArcCot(x) As Double '反余切
ArcCot = ArcSec(x) / ArcCsc(x)
End Function
Private Sub Command10_Click()
Text1 = ""
Text2 = ""
End Sub
Private Sub Command2_Click()
x = Text1
If x = 1 Then
y = pi / 2
ElseIf x = -1 Then
y = 0 - pi / 2
Else
y = ArcSin(x)
End If
If Option1 = True Then
y = Val(y * 180 / pi)
Else
y = y
End If
Text2 = y
End Sub
Private Sub Command3_Click()
Dim x, y
x = Text1
If Option1 = True Then
x = Val(x * pi / 180)
Else
x = x
End If
y = Cos(x)
Text2 = y
End Sub
Private Sub Command4_Click()
x = Text1
If x = 1 Then
y = 0
ElseIf x = -1 Then
y = pi
Else
y = ArcCos(x)
End If
If Option1 = True Then
y = Val(y * 180 / pi)
Else
y = y
End If
Text2 = y
End Sub
Private Sub Command5_Click()
x = Text1
If Option1 = True Then
x = Val(x * pi / 180)
Else
x = x
End If
y = Tan(x)
Text2 = y
End Sub
Private Sub Command6_Click()
Dim x, y
x = Text1
y = Atn(x)
If Option1 = True Then
y = Val(y * 180 / pi)
Else
y = y
End If
Text2 = y
End Sub
Private Sub Command7_Click()
x = Text1
If Option1 = True Then
x = Val(x * pi / 180)
Else
x = x
End If
y = 1 / Tan(x)
Text2 = y
End Sub
Private Sub Command8_Click()
Dim x, y
x = Text1
y = Atn(1 / x)
If Option1 = True Then
y = Val(y * 180 / pi)
Else
y = y
End If
Text2 = y
End Sub
Private Sub Command9_Click()
End
End Sub
Private Sub Option1_Click()
Option1 = True
End Sub
Private Sub Option2_Click()
Option2 = True
End Sub 作者: ysr 时间: 2021-2-10 10:59 本帖最后由 ysr 于 2021-2-10 03:01 编辑
Public Function IIf(ByVal blnExp, vtTrue, vtFalse)
If blnExp Then
IIf = vtTrue
Else
IIf = vtFalse
End If
End Function
Public Function ChangeType(vtData, vtType)
Dim ret
Select Case vtType
Case vbEmpty
Case vbNull
ret = Null
Case vbInteger
ret = ChangeType(vtData, vbDouble)
If ret >= -32768 And ret <= 32767 Then
ret = CInt(ret)
Else
ret = 0
End If
Case vbLong
ret = ChangeType(vtData, vbDouble)
If ret >= -2147483648 And ret <= 2147483647 Then
ret = CLng(ret)
Else
ret = CLng(0)
End If
Case vbSingle
If IsNumeric(vtData) Then
ret = CSng(vtData)
ElseIf VarType(vtData) = vbDecimal Then
ret = CSng(vtData)
Else
ret = CSng(0)
End If
Case vbDouble
If IsNumeric(vtData) Then
ret = CDbl(vtData)
ElseIf VarType(vtData) = vbDecimal Then
ret = CDbl(vtData)
Else
ret = CDbl(0)
End If
Case vbCurrency
ret = ChangeType(vtData, vbDouble)
If ret >= -922337203685477.5808 And ret <= 922337203685477.5807 Then
ret = CCur(ret)
Else
ret = CCur(0)
End If
Case vbDate
If IsDate(vtData) Then
ret = CDate(vtData)
End If
Case vbString
If Not IsNull(vtData) Then
ret = CStr(vtData)
Else
ret = Empty
End If
Case vbBoolean
ret = ChangeType(vtData, vbDouble)
ret = CBool(Not ret = 0)
Case vbByte
ret = ChangeType(vtData, vbDouble)
If ret >= 0 And ret <= 255 Then
ret = CByte(ret)
Else
ret = CByte(0)
End If
Case Else
If VarType(vtData) = vbObject Then
Set ret = vtData
Else
ret = vtData
End If
End Select
ChangeType = ret
End Function
Public Function atos(vtData)
atos = ChangeType(vtData, vbString)
End Function
Public Function atoi(vtData)
atoi = ChangeType(vtData, vbInteger)
End Function
Public Function atol(vtData)
atol = ChangeType(vtData, vbLong)
End Function
Public Function atof(vtData)
atof = ChangeType(vtData, vbDouble)
End Function
Class ImplNumber
Public Function MyFormat(ByVal n)
Dim p, r, l, i
p = atos(n)
l = Len(p)
ReDim r(l - 1)
For i = 1 To l
r(i - 1) = (Asc(Mid(p, i, 1)) And &HFF) - 48
If r(i - 1) < 0 Or r(i - 1) > 10 Then
Err.Raise vbObjectError + 1, "ImplNumber.Format", "第" & (i - 1) & "位字符(" & Chr(r(i - 1) + 48) & ")非数字"
End if
Next
MyFormat = r
End Function
Public Function MyFix(ByVal n)
Dim p
p = atos(n)
Do While Left(p, 1) = "0"
p = Mid(p, 2)
Loop
If p = "" Then p = "0"
MyFix = p
End Function
Private Function Compare(ByVal n1, ByVal n2)
Dim p1, p2
Dim l1, l2
Dim i, i1, i2
p1 = atos(n1)
p2 = atos(n2)
l1 = Len(p1)
l2 = Len(p2)
If l1 > l2 Then
Compare = 1
ElseIf l1 < l2 Then
Compare = -1
ElseIf p1 = p2 Then
Compare = 0
Else
For i = 1 To l1 Step 8
i1 = CLng(Mid(p1, i, 8))
i2 = CLng(Mid(p2, i, 8))
If i1 > i2 Then
Compare = 1
Exit For
ElseIf i1 < i2 Then
Compare = -1
Exit For
End If
Next
End If
End Function
Private Function MyNumber(ByVal l)
Dim r, i
ReDim r(l)
For i = 0 To l
r(i) = 0
Next
MyNumber = r
End Function
Private Function MyAdd(ByVal n1, ByVal n2)
Dim p1, p2, p3
Dim l1, l2, l3
Dim i, t
p1 = MyFormat(n1)
p2 = MyFormat(n2)
l1 = UBound(p1)
l2 = UBound(p2)
l3 = IIf(l1 > l2, l1, l2) + 1
p3 = MyNumber(l3)
t = 0
For i = 0 To l3
If l1 - i >= 0 Then t = t + p1(l1 - i)
If l2 - i >= 0 Then t = t + p2(l2 - i)
p3(l3 - i) = IIf(t > 9, t - 10, t)
t = IIf(t > 9, 1, 0)
Next
MyAdd = MyFix(Join(p3, ""))
Erase p1
Erase p2
Erase p3
End Function
Private Function MySubtract(ByVal n1, ByVal n2)
Dim p1, p2, p3, sign
Dim i, t, l1, l2, l3
Select Case Compare(n1, n2)
Case -1
p1 = MyFormat(n2)
p2 = MyFormat(n1)
sign = "-"
Case 0
MySubtract = "0"
Exit Function
Case 1
p1 = MyFormat(n1)
p2 = MyFormat(n2)
End Select
l1 = UBound(p1)
l2 = UBound(p2)
l3 = l1
p3 = MyNumber(l3)
t = 0
For i = 0 To l3
If l1 - i >= 0 Then t = p1(l1 - i) - t
If l2 - i >= 0 Then t = t - p2(l2 - i)
p3(l3 - i) = IIf(t < 0, t + 10, t)
t = IIf(t < 0, 1, 0)
Next
MySubtract = sign & MyFix(Join(p3, ""))
Erase p1
Erase p2
Erase p3
End Function
'加法
Public Function Add(ByVal n1, ByVal n2)
Dim s1, s2
Dim p1, p2
p1 = MyFix(n1)
p2 = MyFix(n2)
s1 = Left(p1, 1)
s2 = Left(p2, 1)
If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
If s1 = "-" Then
If s2 = "-" Then
Add = "-" & MyAdd(p1, p2)
Else
Add = MySubstract(p2, p1)
End If
Else
If s2 = "-" Then
Add = MySubtract(p1, p2)
Else
Add = MyAdd(p1, p2)
End If
End If
End Function
'减法
Public Function Subtract(ByVal n1, ByVal n2)
Dim s1, s2
Dim p1, p2
p1 = MyFix(n1)
p2 = MyFix(n2)
s1 = Left(p1, 1)
s2 = Left(p2, 1)
If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
If s1 = "-" Then
If s2 = "-" Then
Subtract = MySubstract(p2, p1)
Else
Subtract = "-" & MyAdd(p1, p2)
End If
Else
If s2 = "-" Then
Subtract = MyAdd(p1, p2)
Else
Subtract = MySubtract(p1, p2)
End If
End If
End Function
Private Function MyMultiply(ByVal n1, ByVal n2)
Dim p1, p2, p3, p4
Dim l1, l2, l3
Dim i, k, t
If Compare(n1, n2) = 1 Then
p1 = MyFormat(n2)
p2 = MyFormat(n1)
Else
p1 = MyFormat(n1)
p2 = MyFormat(n2)
End If
l1 = UBound(p1)
l2 = UBound(p2)
p4 = "0"
For i = 0 To l1
l3 = l2 + i + 1
p3 = MyNumber(l3)
t = 0
For k = 0 To l2
t = t + p1(l1 - i) * p2(l2 - k)
p3(l3 - i - k) = IIf(t > 9, (t Mod 10), t)
t = IIf(t > 9, t / 10, 0)
Next
If t > 0 Then
p3(l3 - i - k) = t
End If
p4 = MyAdd(p4, MyFix(Join(p3, "")))
Erase p3
Next
MyMultiply = p4
Erase p1
Erase p2
End Function
'乘法
Public Function Multiply(ByVal n1, ByVal n2)
Dim s1, s2
Dim p1, p2
p1 = MyFix(n1)
p2 = MyFix(n2)
s1 = Left(p1, 1)
s2 = Left(p2, 1)
If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
If p1 = "0" Or p2 = "0" Then
Multiply = "0"
ElseIf s1 = "-" Then
If s2 = "-" Then
Multiply = MyMultiply(p1, p2)
Else
Multiply = "-" & MyMultiply(p1, p2)
End If
Else
If s2 = "-" Then
Multiply = "-" & MyMultiply(p1, p2)
Else
Multiply = MyMultiply(p1, p2)
End If
End If
End Function
Private Function MyDiv(ByVal n1, ByVal n2)
Dim p(1), n3, i
n3 = MySubtract(n1, n2)
i = 1
Do While Compare(n3, n2) <> -1
n3 = MySubtract(n3, n2)
i = i + 1
Loop
p(0) = i
p(1) = n3
MyDiv = p
End Function
Private Function MyDivision(ByVal n1, ByVal n2, ByVal decimal, ByVal sign)
Dim p1, p2, p3(1), p4, p5
Dim i, cmp, l1, l2, lx
If decimal > 0 Then
p1 = n1 & String(decimal, "0")
Else
p1 = n1
End If
p2 = n2
cmp = Compare(p1, p2)
If cmp = -1 Then
p3(0) = 0
p3(1) = n1
MyDivision = p3
Exit Function
End If
If cmp = 0 Then
If decimal > 0 Then
p3(0) = sign & "0." & String(decimal - 1, "0") & 1
p3(1) = n1
Else
p3(0) = sign & "1"
p3(1) = 0
End If
MyDivision = p3
Exit Function
End If
l1 = Len(p1)
l2 = Len(p2)
lx = Len(n1)
p4 = Mid(p1, 1, l2)
i = l2
p3(0) = sign
If decimal > 0 And i > lx Then
p3(0) = p3(0) & "." & String(i - lx - 1, "0")
End If
Do While i <= l1
If Compare(p4, p2) <> -1 Then
p5 = MyDiv(p4, p2)
p4 = p5(1)
p3(0) = p3(0) & p5(0)
ElseIf i = l1 Then
If i = lx Then p3(1) = MyFix(p4)
Exit Do
Else
If i = lx Then
p3(1) = MyFix(p4)
If decimal > 0 Then p3(0) = p3(0) & "."
End If
i = i + 1
p4 = MyFix(p4 & Mid(p1, i, 1))
If Compare(p4, p2) = -1 Then p3(0) = p3(0) & "0"
End If
Loop
MyDivision = p3
End Function
'除法
'decimal = 小数点后的位数
'函数返回拥有两个元素的数组
'元素0 = 商
'元素1 = 余数
Public Function Division(ByVal n1, ByVal n2, ByVal decimal)
Dim s1, s2
Dim p1, p2
p1 = MyFix(n1)
p2 = MyFix(n2)
s1 = Left(p1, 1)
s2 = Left(p2, 1)
If s1 = "-" Then p1 = MyFix(Mid(p1, 2))
If s2 = "-" Then p2 = MyFix(Mid(p2, 2))
If p1 = "0" Then
Division = Array(0, 0)
ElseIf p2 = "0" Then
Err.Raise vbObjectError + 1, "ImplNumber.Division", "被零除"
ElseIf s1 = "-" Then
If s2 = "-" Then
Division = MyDivision(p1, p2, decimal, "")
Else
Division = MyDivision(p1, p2, decimal, "-")
End If
Else
If s2 = "-" Then
Division = MyDivision(p1, p2, decimal, "-")
Else
Division = MyDivision(p1, p2, decimal, "")
End If
End If
End Function
'将一个10进制整数进行(2 - 36)进制的转换
Public Function BaseX(ByVal n, ByVal x)
Dim s, i, p
If x < 2 Then
Err.Raise vbObjectError + 1, "ImplNumber.BaseX", "错误的进制"
End If
If Compare(n, "0") = 1 Then
p = Division(n, x, 0)
s = s & BaseX(p(0), x)
i = CInt(p(1))
If i < 10 Then
s = s & i
Else
s = s & Chr(i + 55)
End If
End If
BaseX = s
End Function
'将一个(2 - 36)进制的字符转换成10进制的整数
Public Function ConvertX(ByVal s, ByVal x)
Dim i
Dim n, p, t
If x < 2 Then
Err.Raise vbObjectError + 1, "ImplNumber.ConvertX", "错误的进制"
End If
n = 0
p = 1
For i = Len(s) To 1 Step -1
t = Asc(Mid(s, i, 1)) And &HFF
If t >= 48 And t <= 57 Then
t = t - 48
ElseIf t >= 65 And t < 55 + x And t <= 90 Then
t = t - 55
ElseIf t >= 97 And t < 87 + x And t <= 122 Then
t = t - 87
Else
Err.Raise vbObjectError + 1, "ImplNumber.ConvertX", "错误的进制字符串"
End If
n = Add(n, Multiply(t, p))
p = Multiply(p, x)
Next
ConvertX = n
End Function
End Class
'范例
Dim num, i, x
Set num = New ImplNumber
WScript.Echo num.Add(784921795923989, 5215632421426)
WScript.Echo num.Subtract(784921795923989, 5215632421426)
WScript.Echo num.Multiply(784921795923989, 5215632421426)
WScript.Echo Join(num.Division(784921795923989, 5215632421426, 12), " - ")
For i = 2 To 36
x = num.BaseX(784921795923989, i)
WScript.Echo "Base" & i & "(" & num.ConvertX(x, i) & ") = " & x
Next
Set num = Nothing 作者: ysr 时间: 2021-11-12 21:27
连乘积公式结果： 偶数9866 其方根为99.3277403347121 其方根内最大素数97 方根内的素数个数m=25 每m-1个中的平均值3.75350895581372 总个数为94.4596518857898 方根内能产生的素数对个数：0.950989638619403
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作者: ysr 时间: 2023-3-6 10:21
Private Function fenjieyinzi3(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(Val(x) / I, ".") = 0 Then
a = False
Exit For
Else: a = True
End If
Next
End If
End If
If a = True Then
fenjieyinzi3 = "这是个素数"
Else
fenjieyinzi3 = "2*2"
End If