数学中国

 找回密码
 注册
搜索
热搜: 活动 交友 discuz
12
返回列表 发新帖
楼主: ysr

目前难于分解的合数

[复制链接]
 楼主| 发表于 2025-10-8 11:20 | 显示全部楼层
本帖最后由 ysr 于 2025-11-21 10:16 编辑

Private Function mbbc3(sa As String, sd As String) As String 'kai lifang jingdu daifh
Dim ja
If Val(Len(sa)) = 1 And Val(sa) = 0 Then
   mbbc3 = 0
   Else
   
fh = fhys(sa)
ja = MBBC1(qdfh(sa) & String(Val(sd) * 2, "0"))
If InStr(ja, "/") = 0 And Val(fh) > 0 Then
mbbc3 = ja
Else
If InStr(ja, "/") = 0 And Val(fh) < 0 Then
mbbc3 = "-" & ja
Else
If Val(fh) > 0 Then
mbbc3 = Left(ja, InStr(ja, "/") - 1)
Else
mbbc3 = "-" & Left(ja, InStr(ja, "/") - 1)

End If
End If
End If
End If


End Function

Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
If Val(sa) = 0 Or Val(sb) = 0 Then
mbc2 = 0
Else
ja = MbC(Trim(sa), Trim(sb))


mbc2 = Left(ja, Val(Len(ja) - sd))

End If
End Function

Private Function mcc2(sa As String, sb As String, sd As String) As String 'chufa jingdu daifh
Dim ja

ja = MCC1(Trim(sa) & String(sd, "0"), Trim(sb))
If InStr(ja, "/") = 0 Then
mcc2 = ja
Else

mcc2 = Left(ja, InStr(ja, "/") - 1)

End If
End Function

Private Function qdqiandao0(sa As String) As String
Do While Left(sa, 1) = "0"
sa = Mid(sa, 2)
Loop
If Len(sa) = 0 Then
qdqiandao0 = 0
Else
qdqiandao0 = sa
End If
End Function

Private Function jsmssushu(sa As String) As String
Dim B
B = 1
Do While c <= sa - 1
B = MbC(Trim(B), 2)
c = c + 1
Loop
jsmssushu = MPC(Trim(B), 1)
End Function

Private Function fenjieyinzi0(a As String) As String
x = 3
Do While InStr(MCC(Trim(a), 2), "/") = 0 And MBJC(Trim(a), 4) >= 0

  
If B = 0 Then
fenjieyinzi0 = fenjieyinzi0 & "2"
B = 1
Else
fenjieyinzi0 = fenjieyinzi0 & "*2"
End If
a = MCC(Trim(a), 2)
k = a
  
Loop

Do While MBJC(Trim(a), "0001") > 0
Do While MBJC(Trim(x), zhengchuqy(MBBC(Trim(a)))) <= 0
Do While InStr(MCC1(Trim(a), Trim(x)), "/") = 0 And MBJC(Trim(a), MbC(Trim(x), Trim(x))) >= 0
  
If B = 0 Then
fenjieyinzi0 = fenjieyinzi0 & x
B = 1
Else
fenjieyinzi0 = fenjieyinzi0 & "*" & x
End If
a = MCC1(Trim(a), Trim(x))
Loop
  
x = MPC1(Trim(x), 2)
Loop
  
k = a
a = 1
Loop
  
If B = 1 Then
fenjieyinzi0 = fenjieyinzi0 & "*" & k
Else
fenjieyinzi0 = "这是一个质数"
End If
End Function



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

回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-11-9 00:10 | 显示全部楼层
本帖最后由 ysr 于 2025-11-19 03:23 编辑

'分解3535000647287053716310161223639238642910682574781777736223167的程序
Private Sub Command1_Click()
Dim a, B
a = Trim(Text1)
t = Timer
If Len(a) <= 10 Then
Text2 = fenjieyinzi(Trim(a))
Else
If Len(a) <= 13 Then
Text2 = fenjieyinzi0(Trim(a))
Else
B = zhengchuqy(MBBC(Trim(a)))

If InStr(MCC1(Trim(a), Trim(B)), "/") = 0 Then
Text2 = B & "*" & MCC1(Trim(a), Trim(B))
Else
s1 = 2
c = 2
Do While s1 <= 1048576 And InStr(MCC1(Trim(a), Trim(c)), "/") <> 0

c = zhengchuqy(MBBC(zhengchuqy(MCC(Trim(a), Trim(s1)))))
s1 = s1 * 2
Loop
B1 = zhengchuqy(MBBC(zhengchuqy(MCC(Trim(a), 4))))
If zhengchuqyushu(MCC(Trim(a), 4)) = 1 Then
Do While MBJC(MbC(Trim(B1), MPC1(Trim(B1), 1)), zhengchuqy(MCC(Trim(a), 4))) = -1
B1 = B1 + 1
Loop
Else
Do While MBJC(MbC(MPC1(Trim(B1), 1), MPC1(Trim(B1), 1)), zhengchuqy(MCC(Trim(a), 4))) = -1
B1 = B1 + 1
Loop
End If

Dim sa()
ReDim sa(1 To 10)
sa(1) = 13: sa(2) = 17: sa(3) = 19: sa(4) = 31: sa(5) = 61
sa(6) = 89: sa(7) = 107: sa(8) = 127: sa(9) = 521: sa(10) = 607
a1 = 1 & "/" & 2
sb = 1
s = 0
Do While Len(sb) <= Len(a) And InStr(a1, "/") <> 0 And s < 10
s = Val(s + 1)
sb = jsmssushu(Trim(sa(s)))
a1 = MCC1(Trim(a), Trim(sb))
Loop

If zhengchuqyushu(MCC(Trim(a), 4)) = 1 Then

C1 = zhengchuqy(MBBC(MPC(MbC(Trim(B1), MPC1(Trim(B1), 1)), zhengchuqy(MCC(Trim(a), 4)))))
Else

C1 = zhengchuqy(MBBC(MPC(MbC(MPC1(Trim(B1), 1), MPC1(Trim(B1), 1)), MPC1(zhengchuqy(MCC(Trim(a), 4)), 1))))
End If
If Right(a, 2) Mod 4 = 1 Then
B1 = MPC1(Trim(B1), 1)
Else
B1 = B1
End If

If InStr(MCC1(Trim(a), Trim(c)), "/") = 0 Then
Text2 = c & "*" & MCC1(Trim(a), Trim(c))
Else
If InStr(MCC1(Trim(a), MPC1(MbC(MPC(Trim(B1), Trim(C1)), 2), 1)), "/") = 0 Then
Text2 = MPC1(MbC(MPC(Trim(B1), Trim(C1)), 2), 1) & "*" & MCC1(Trim(a), MPC1(MbC(MPC(Trim(B1), Trim(C1)), 2), 1))
Else
If InStr(a1, "/") = 0 Then
Text2 = sb & "*" & a1
Else
d = zhengchuqy(MCC(Trim(a), 4))
jn = zhengchuqy(MCC1(Trim(d), MbC(Trim(B), 2)))
jp = MPC1(MbC(Trim(jn), 2), 1)
jq = zhengchuqy(MCC1(Trim(a), Trim(jp)))
jr1 = zhengchuqyushu(MCC1(Trim(a), Trim(jp)))
jr2 = zhengchuqyushu(MCC1(Trim(a), MPC1(Trim(jp), 2)))
If MBJC(Trim(jr2), Trim(jr1)) >= 0 Then
jf1 = MPC(Trim(jr2), Trim(jr1))
Else
jf1 = MPC(Trim(jr1), Trim(jr2))
End If
jf2 = zhengchuqy(MCC1(Trim(jp), Trim(jf1)))
jp2 = MPC1(Trim(jp), MbC(Trim(jf2), 4))

jx = zhengchuqy(MCC(MPC(Trim(jq), Trim(jp)), 4))
b8 = zhengchuqy(MCC1(Trim(jx), Trim(jn)))
ja = MbC(Trim(b8), 8)
jb1 = MbC(MbC(Trim(b8), Trim(jp)), 2)
If MBJC(Trim(jb1), Trim(jq)) >= 0 Then
jb = MbC(MPC(MbC(MbC(Trim(b8), Trim(jp)), 2), Trim(jq)), 2)
Else
jb = "-" & MbC(MPC(Trim(jq), MbC(MbC(Trim(b8), Trim(jp)), 2)), 2)
End If
jc = MPC(Trim(a), MbC(Trim(jq), Trim(jp)))
jc = MPC(Trim(a), MbC(Trim(jq), Trim(jp)))
ja1 = Trim(ja) & String(10, "0")
jb1 = Trim(jb) & String(10, "0")
jc1 = Trim(jc) & String(10, "0")
jf = jie2cifc(Trim(ja1), Trim(jb1), Trim(jc1), 10)
Print jf
b3 = 1041
Do While b3 >= 1041
b4 = b3 * 853

n1 = zhengchuqy(MCC(Trim(d), Trim(b3)))
n2 = zhengchuqy(MBBC(Trim(n1)))
p1 = MPC1(MbC(Trim(n2), 2), 1)
r = zhengchuqyushu(MCC1(Trim(a), Trim(p1)))
q = zhengchuqy(MCC1(Trim(a), Trim(p1)))
q1 = MCC1(Trim(a), Trim(p1))
If MBJC(Trim(r), 0) = 0 Then
p2 = p1
Text2 = p2 & "*" & q
Else
r9 = p1
Print p1

p4 = r9

p = p4
q1 = MCC1(Trim(a), Trim(p))
q = zhengchuqy(Trim(q1))

B1 = zhengchuqy(MCC1(q & String(Len(p4), "0"), Trim(p)))
b6 = "100057991087214518562694508532"
b7 = "119124090279615294549011141875"
b8 = "99999999513536191490633492"
b4 = mbc2(Trim(B1), Trim(b6), 29)
b5 = mbc2(Trim(B1), Trim(b7), 29)
q5 = mbc2(Trim(p), Trim(b5), Len(p4))
q4 = mbc2(Trim(p), Trim(b4), Len(p4))
p6 = zhengchuqy(MCC1(Trim(a), Trim(q4)))
p7 = zhengchuqy(MCC1(Trim(a), Trim(q5)))
q1 = zhengchuqy(MCC1(Trim(a), Trim(p6)))
q2 = zhengchuqy(MCC1(Trim(a), Trim(p7)))
b9 = mbc2(zhengchuqy(MCC1(q1 & String(29, "0"), Trim(p6))), Trim(b6), 29)
b10 = mbc2(zhengchuqy(MCC1(q2 & String(26, "0"), Trim(p7))), Trim(b8), 26)

p8 = zhengchuqy(MCC1(Trim(a), mbc2(Trim(p6), Trim(b9), 29)))
p9 = zhengchuqy(MCC1(Trim(a), mbc2(Trim(p7), Trim(b10), 26)))
Print B1
Print p6
Print p7
Print p8
Print p9

If zhengchuqyushu(MCC1(Trim(a), Trim(p4))) = 0 Then
Text2 = p4 & "*" & MCC1(Trim(a), Trim(p4))
Else
p5 = p1
Do While Len(p4) >= Len(p5) And zhengchuqyushu(MCC1(Trim(a), Trim(p4))) <> 0 And s12 <= 10
p4 = MPC(Trim(p4), 2)
s12 = s12 + 1
Loop
If zhengchuqyushu(MCC1(Trim(a), Trim(p4))) = 0 Then
Text2 = p4 & "*" & MCC1(Trim(a), Trim(p4))
Else
Dim x, y
x = Len(a) \ 5: y = Len(p4) \ 5
a = String(5 - Len(a) + 5 * x, "0") & a: p4 = String(5 - Len(p4) + 5 * y, "0") & p4
Print a
Dim aa() As String
ReDim aa(5 To 5 * x + 5)
Dim bb() As String
ReDim bb(5 To 5 * y + 5)
Dim i, j, js
For i = 5 To 5 * x + 5 Step 5
aa(i) = Mid(a, i - 4, 5)
Next
For j = 5 To 5 * y + 5 Step 5
bb(j) = Mid(p4, j - 4, 5)
Next
js = MCC1(qdqiandao0(aa(5) & aa(10) & aa(15)), qdqiandao0(bb(5) & bb(10)))
js17 = qdqiandao0(bb(5) & bb(10))
Print js17
s17 = Len(js17)
s19 = 420000
Dim jsc()
ReDim jsc(1 To s19 + 1)
Do While s13 <= s19

s13 = s13 + 1
jsc(s13) = js17

If s13 = 337741 Then
js6 = js17
Print js6
Else
js7 = js17

End If



js17 = Val(js17 - 1)

Loop
If y >= 2 Then
jss = jsc(337741)
For i11 = 3 To y + 1
s19 = i11 * 5
jss = jss & bb(s19)
Next
Else
jss = js6
End If
jss4 = jss
Print r9, jss
If InStr(MCC1(qdqiandao0(Trim(a)), Trim(jss)), "/") = 0 Then
Text2 = jss & "*" & MCC1(qdqiandao0(Trim(a)), Trim(jss))
Else
a = qdqiandao0(Trim(a))
s21 = "9999999951353619149063" '22位的
s22 = "99999999513536191490633492" '26位的
s23 = "999999995135361914906334919" '27位的
q3 = MCC1(Trim(a), Trim(jss))
q4 = zhengchuqy(Trim(q3))
r13 = zhengchuqyushu(Trim(q3))
f7 = "295272111931977014044900 "
f4 = zhengchuqy(MCC1(q4 & String(Len(jss), "0"), Trim(jss)))
f2 = MbC(Trim(f4), Trim(s23))
f2 = Left(f2, Len(f2) - 27)
f6 = f2
b5 = MPC(Trim(q4), mbc2(Trim(f2), Trim(jss), Len(jss)))
b6 = MbC(Trim(r13), Trim(f2))
D1 = MPC(MbC(Trim(b5), Trim(b5)) & String(Len(jss), "0"), MbC(Trim(b6), 4))
D2 = zhengchuqy(MBBC(Trim(D1) & String(Len(jss), "0")))
f1 = zhengchuqy(MCC1(MPC1(Trim(b5) & String(Len(jss), "0"), Trim(D2)) & String(Len(jss) + 10, "0"), MbC(Trim(f2), 2)))
f5 = Len(f1) - Len(jss) - 10
f2 = Mid(f1, 1, f5)
f5 = MbC(Trim(f2), 98)
f5 = Left(f5, Len(f5) - 1)
x4 = mbc2(Trim(f2), Trim(f6), Len(jss))
Print f6
Print f2
Print x4
f3 = "283314068346029014014"
x3 = zhengchuqy(MCC1(MPC(MbC(Trim(q4), Trim(f2)), Trim(r13)), MPC1(Trim(jss), Trim(f2))))
jss = zhengchuqy(MCC1(Trim(a), MPC(Trim(q4), Trim(x3))))
jss1 = MPC1(Trim(jss4), Trim(f2))
jss2 = MPC(Trim(jss4), Trim(f2))
q5 = MPC(MbC(Trim(q4), Trim(q4)), Trim(a))
q6 = zhengchuqy(MBBC(Trim(q5)))
jss3 = MPC(Trim(q4), Trim(q6))
jss5 = zhengchuqy(MCC(Trim(jss4), 2))
jss3 = MPC1(Trim(jss3), Trim(jss5))
If Right(jss, 1) Mod 2 = 0 Then
jss = MPC(Trim(jss), 1)
Else
jss = jss
End If
Print jss
Print jss1
Print jss2
Print jss3
Print jss4
If Right(jss1, 1) Mod 2 = 0 Then
jss1 = MPC(Trim(jss1), 1)
Else
jss1 = jss1
End If
jss8 = jss
Do While InStr(MCC1(qdqiandao0(Trim(a)), Trim(jss)), "/") <> 0 And s15 <= 6000
s15 = s15 + 1
jss = MPC1(Trim(jss), 2)
Loop
If InStr(MCC1(Trim(a), Trim(jss)), "/") = 0 Then
Text2 = jss & "*" & MCC1(Trim(a), Trim(jss)) & "   中间数据X=" & x3
Else
Do While InStr(MCC1(Trim(a), Trim(jss8)), "/") <> 0 And s16 <= 6500
s16 = s16 + 1
jss8 = MPC(Trim(jss8), 2)
Loop
Text2 = jss8 & "*" & MCC1(Trim(a), Trim(jss8))
End If




End If
End If
End If
End If
b3 = b3 - 2
Loop
End If
End If
End If
End If
End If
End If
Text3 = Timer - t & "秒    " & jp2
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Form1.Cls
End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-11-10 21:52 | 显示全部楼层
本帖最后由 ysr 于 2025-11-17 01:20 编辑

Public Function jie2cifc(a2 As String, b2 As String, c2 As String, sd As String) As String '2次方程
Dim d, y
b3 = b2
b2 = qdfh(b2)
d = mbc2(Trim(b2), Trim(b2), Val(sd))
D1 = mpc2(Trim(d), mbc2(4 & String(sd, "0"), mbc2(Trim(a2), Trim(c2), Val(sd)), Val(sd)))
d3 = qdfh(Trim(D1))
D2 = mbbc2(Trim(d3), Val(sd))
y = mcc2(Trim(b2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
sf = fhys(Trim(b3))
sf = Val(-1 * sf)
y = tjfh(qdfh(Trim(y)), Val(sf))
y = shuchujg(Trim(y), Val(sd))
If mbjc2(Trim(D1), 0) >= 0 Then
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd))
Else
d3 = mcc2(Trim(D2), mbc2(2 & String(sd, "0"), Trim(a2), Val(sd)), Val(sd))
d3 = shuchujg(Trim(d3), Val(sd)) & "i"
End If
jie2cifc = y & "+ -" & d3
End Function
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-11-12 11:56 | 显示全部楼层
Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))


If Val(fh1) > 0 Then
mpc2 = ja
Else

mpc2 = "-" & ja


End If
Else

If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If

End Function
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-11-12 18:48 | 显示全部楼层
本帖最后由 ysr 于 2025-11-29 10:00 编辑

Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, I)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
End If
End Function

Private Function jsfanzq(sa As String, sd As String) As String
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 0 Then
jsfanzq = zhengchuqy(MCC1(jspaizh(sd), Val(2)))
Else
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
sa1 = zhengchuqy(MCC1(1 & String(2 * Val(sd), "0"), qdfh(Trim(sa))))
Else
sa1 = qdfh(Trim(sa))
End If


Dim s1
s1 = 1 & String(Val(sd), "0")
s2 = mbc2(Trim(sa1), Trim(sa1), Val(sd))
fs1 = -1
s3 = 3
Do While MBJC(zhengchuqy(MCC1(Trim(s1), Val(s3))), 1) >= 0
s1 = mbc2(Trim(s1), Trim(s2), Val(sd))

s = mpc3(Trim(s), tjfh(zhengchuqy(MCC1(Trim(s1), Val(s3))), Val(fs1)))

s3 = Val(Val(s3) + 2)

fs1 = Val(-1) * Val(fs1)


Loop

js4 = mbc2(Trim(sa1), mpc3(Val(1) & String(Val(sd), "0"), Trim(s)), Val(sd))
fsa = fhys(Trim(sa))
If MBJC(qdfh(Trim(sa)), 1 & String(sd, "0")) = 1 Then
jsfanzq = tjfh(mpc2(jspaizh(sd), Trim(js4)), Val(fsa))
Else
  jsfanzq = tjfh(Trim(js4), Val(fsa))
  End If
End If
End Function
回复 支持 反对

使用道具 举报

 楼主| 发表于 2025-11-12 19:24 | 显示全部楼层
本帖最后由 ysr 于 2025-11-18 00:06 编辑

Private Function mbbc2(sa As String, sd As String) As String 'kai pingfang jingdu
Dim ja
If Val(Len(sa)) = 1 And Trim(sa) = 0 Then
mbbc2 = 0
Else

ja = MBBC(Trim(sa) & String(Val(sd), "0"))

If InStr(ja, "/") = 0 Then
mbbc2 = ja
Else
mbbc2 = Left(ja, InStr(ja, "/") - 1)
End If
End If

End Function

Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else

ja = MBJC(qdfh(sa), qdfh(sb))

If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If



End Function


Private Function shuchujg(sa As String, sd As String) As String
'shuchu jieguo
If Len(qqdl(sa)) = 1 And Trim(qqdl(sa)) = 0 Then
shuchujg = 0
Else
sa1 = MPC1(qdfh(Trim(sa)), 49)
fsa = fhys(Trim(sa))
If Len(sa1) = Val(sd) Then
a1 = 0
jb1 = sa1
Else
If Len(sa1) < Val(sd) Then
a1 = 0
jb1 = String(Val(sd) - Len(sa1), "0") & sa1
Else
a1 = Left(sa1, Len(sa1) - Val(sd))
jb1 = Right(sa1, Val(sd))
End If
End If
jb2 = Left(jb1, Val(sd) - 2)
If MBJC(qqdl(Trim(jb2)), 0) = 0 Then
  shuchujg = tjfh(Trim(a1), Val(fsa))
  Else
  shuchujg = tjfh(Trim(a1), Val(fsa)) & "." & jb2
  End If
  End If

End Function


Private Function tjxsd(sa As String, sd As String) As String
If Val(Len(sa)) > Val(sd) Then
tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
Else
If Val(Len(sa)) = Val(sd) Then
  tjxsd = "0." & sa
  Else
  tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
  End If
  End If

End Function
Private Function ydxsd(sa As String, sd As String) As String
If Len(sa) = 1 And Trim(sa) = 0 Then
  ydxsd = 0
  Else
  
    sc = InStr(sa, ".")
    If Val(sc) = 0 Then
    ydxsd = sa & String(sd, "0")
    Else
    se = Left(sa, Val(sc) - 1)
    sf = Right(sa, Len(sa) - Val(sc))
    If Val(Len(sf)) >= Val(sd) Then
    ydxsd = se & Mid(sf, 1, sd)
      Else
      ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
      End If
      End If
      End If
      End Function
      
Private Function fhys(sa As String) As String

If InStr(sa, "-") = 0 Then
  fhys = 1
   Else
   fhys = -1
End If

   
End Function
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If



   
End Function

Private Function qdfh(sa As String) As String

If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If


   
End Function
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-12-7 15:52 , Processed in 0.102011 second(s), 14 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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