|
楼主 |
发表于 2021-3-25 11:38
|
显示全部楼层
本帖最后由 ysr 于 2021-4-4 04:45 编辑
第8页73#楼合74#楼的程序单独都可以用,加载主程序中则需要加上去掉前导0的程序,稍加改动,重发如下:
Public Function MbC(D1 As String, D2 As String) As String
Dim X, Y ';两数长度
X = Len(D1) \ 4: Y = Len(D2) \ 4
D3 = String(4 * X + 4 - Len(D1), "0") & D1
D4 = String(4 * Y + 4 - Len(D2), "0") & D2
X = X + 1: Y = Y + 1
Dim A() As String
ReDim A(4 To 4 * X + 4 * Y, 4 To 4 * Y)
Dim I, J, C1, C2, CJ, JW, s, t
For J = 4 * Y To 4 Step -4 ';D2
JW = 0 ';进位清0
C2 = Mid(D4, J - 3, 4) ';每位数
For I = 4 * X To 4 Step -4 ';D1
C1 = Mid(D3, I - 3, 4) ';每位数
CJ = Val(C1) * Val(C2) + JW ';计算乘积
c = I + J: R = 4 * Y + 4 - J
A(c, R) = String(4 - Len(CJ Mod 10000), "0") & CJ Mod 10000 ';本位
JW = CJ \ 10000 ';进位
Next
A(c - 4, R) = JW
Next
Dim B() As String
ReDim B(1 To X + Y)
JW = 0
For s = X + Y To 1 Step -1
Bit = JW
For t = 1 To Y
Bit = Bit + Val(A(4 * s, 4 * t))
Next
B(s) = String(4 - Len(Bit Mod 10000), "0") & Bit Mod 10000
JW = Bit \ 10000
Next
If B(1) > 0 Then
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6) & B(1)
Else
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6)
End If
For s = 2 To X + Y
MbC = Val(Left(MbC, 5)) & Mid(MbC, 6) & B(s)
Next
End Function
'该程序已经做了修改,不是去掉前导0的问题,是补够前导0的问题。
|
|