這可是包仔寫很久才寫出來的
提出來與大家分享
至於除法嘛...我還沒寫出來
Public Function AddFunction(Value1 As String, Value2 As String) As String '長整數相加
Dim i As Integer
Dim j As Integer
Dim Values1(100) As Integer
Dim Values2(100) As Integer
Dim OkValues(100) As Integer
Dim Steps As Integer
Dim Limit As Integer
Dim MaxCounts As Integer
If Len(Value1) ＞= Len(Value2) Then MaxCounts = Len(Value1) Else MaxCounts = Len(Value2)
For i = Len(Value1) To 1 Step -1
Steps = Steps + 1
Values1(Steps) = Val(Mid(Value1, i, 1))
Next i
Steps = 0
For i = Len(Value2) To 1 Step -1
Steps = Steps + 1
Values2(Steps) = Val(Mid(Value2, i, 1))
Next i
For i = 1 To MaxCounts
OkValues(i) = OkValues(i) + Values1(i) + Values2(i)
If OkValues(i) ＞= 10 Then
Limit = MaxCounts + 1
OkValues(i + 1) = OkValues(i + 1) + 1
OkValues(i) = OkValues(i) - 10
Else
Limit = MaxCounts
End If
Next i
AddFunction = ""
For i = Limit To 1 Step -1
AddFunction = AddFunction & Trim(OkValues(i))
Next i
If AddFunction = "" Then AddFunction = "0'"
End Function
Public Function DecFunction(Value1 As String, Value2 As String) '長整數相減
Dim i As Integer
Dim j As Integer
Dim Values1(100) As Integer
Dim Values2(100) As Integer
Dim BigValue As String
Dim SmallValue As String
Dim OverZero As Boolean
Dim OkValues(100) As Integer
Dim Limit As Integer
Dim MaxCounts As Integer
If Len(Value1) ＞ Len(Value2) Then Value2 = String(Len(Value1) - Len(Value2), "0") & Value2
If Len(Value1) ＜ Len(Value2) Then Value1 = String(Len(Value2) - Len(Value1), "0") & Value1
For i = 1 To Len(Value1)
If Mid(Value1, i, 1) ＞ Mid(Value2, i, 1) Then
BigValue = Value1
SmallValue = Value2
OverZero = False
Exit For
End If
If Mid(Value1, i, 1) ＜ Mid(Value2, i, 1) Then
BigValue = Value2
SmallValue = Value1
OverZero = True
Exit For
End If
Next i
For i = 1 To Len(BigValue)
Values1(i) = Val(Mid(BigValue, Len(BigValue) - i + 1, 1))
Values2(i) = Val(Mid(SmallValue, Len(SmallValue) - i + 1, 1))
OkValues(i) = OkValues(i) + Values1(i) - Values2(i)
If OkValues(i) ＜ 0 And i ＜ Len(BigValue) Then
OkValues(i + 1) = OkValues(i + 1) - 1
OkValues(i) = OkValues(i) + 10
End If
Next i
For i = Len(BigValue) To 1 Step -1
If OkValues(i) ＜＞ 0 Then
Limit = i
Exit For
End If
Next i
DecFunction = ""
For i = 1 To Limit
DecFunction = Trim(OkValues(i)) & DecFunction
Next i
If OverZero = True Then DecFunction = "-" & DecFunction
If DecFunction = "" Then DecFunction = "0"
End Function
Public Function SubFunction(Value1 As String, Value2 As String) As String '長整數相乘
Dim Code1(100) As Integer
Dim Code2(100) As Integer
Dim Code3(201) As Integer
Dim Steps1 As Integer
Dim Steps2 As Integer
Dim Subtotal As Integer
ii = Len(Value1)
jj = Len(Value2)
Steps1 = 0
For i = ii To 1 Step -1
Steps1 = Steps1 + 1
Code1(Steps1) = Val(Mid(Value1, i, 1))
Steps2 = 0
For j = jj To 1 Step -1
Steps2 = Steps2 + 1
Code2(Steps2) = Val(Mid(Value2, j, 1))
Code3(Steps1 + Steps2 - 1) = Code3(Steps1 + Steps2 - 1) + (Code1(Steps1) * Code2(Steps2))
If Code3(Steps1 + Steps2 - 1) ＞= 10 Then
u = Code3(Steps1 + Steps2 - 1) \ 10
Code3(Steps1 + Steps2 - 1) = Code3(Steps1 + Steps2 - 1) - u * 10
Code3(Steps1 + Steps2) = Code3(Steps1 + Steps2) + u
End If
Next j
Next i
For a = 1 To ii + jj - 1
If Code3(a) ＞= 10 Then
u = Code3(a) \ 10
Code3(a + 1) = Code3(a + 1) + u
Code3(a) = Code3(a) - u * 10
End If
Next a
SubFunction = ""
If Code3(ii + jj) ＜＞ 0 Then t = ii + jj Else t = ii + jj - 1
For i = t To 1 Step -1
SubFunction = SubFunction + Trim(Code3(i))
Next i
If SubFunction = "" Then SubFunction = "0"
End Function
Public Function DivFunction(Value1 As String, Value2 As String) As String '長整數相加
Dim MaxLen As Integer
If Len(Value1) ＞= Len(Value2) Then MaxLen = Len(Value1) Else MaxLen = Len(Value2)
If DivFunction = "" Then DivFunction = "0"
End Function
提出來與大家分享
至於除法嘛...我還沒寫出來
Public Function AddFunction(Value1 As String, Value2 As String) As String '長整數相加
Dim i As Integer
Dim j As Integer
Dim Values1(100) As Integer
Dim Values2(100) As Integer
Dim OkValues(100) As Integer
Dim Steps As Integer
Dim Limit As Integer
Dim MaxCounts As Integer
If Len(Value1) ＞= Len(Value2) Then MaxCounts = Len(Value1) Else MaxCounts = Len(Value2)
For i = Len(Value1) To 1 Step -1
Steps = Steps + 1
Values1(Steps) = Val(Mid(Value1, i, 1))
Next i
Steps = 0
For i = Len(Value2) To 1 Step -1
Steps = Steps + 1
Values2(Steps) = Val(Mid(Value2, i, 1))
Next i
For i = 1 To MaxCounts
OkValues(i) = OkValues(i) + Values1(i) + Values2(i)
If OkValues(i) ＞= 10 Then
Limit = MaxCounts + 1
OkValues(i + 1) = OkValues(i + 1) + 1
OkValues(i) = OkValues(i) - 10
Else
Limit = MaxCounts
End If
Next i
AddFunction = ""
For i = Limit To 1 Step -1
AddFunction = AddFunction & Trim(OkValues(i))
Next i
If AddFunction = "" Then AddFunction = "0'"
End Function
Public Function DecFunction(Value1 As String, Value2 As String) '長整數相減
Dim i As Integer
Dim j As Integer
Dim Values1(100) As Integer
Dim Values2(100) As Integer
Dim BigValue As String
Dim SmallValue As String
Dim OverZero As Boolean
Dim OkValues(100) As Integer
Dim Limit As Integer
Dim MaxCounts As Integer
If Len(Value1) ＞ Len(Value2) Then Value2 = String(Len(Value1) - Len(Value2), "0") & Value2
If Len(Value1) ＜ Len(Value2) Then Value1 = String(Len(Value2) - Len(Value1), "0") & Value1
For i = 1 To Len(Value1)
If Mid(Value1, i, 1) ＞ Mid(Value2, i, 1) Then
BigValue = Value1
SmallValue = Value2
OverZero = False
Exit For
End If
If Mid(Value1, i, 1) ＜ Mid(Value2, i, 1) Then
BigValue = Value2
SmallValue = Value1
OverZero = True
Exit For
End If
Next i
For i = 1 To Len(BigValue)
Values1(i) = Val(Mid(BigValue, Len(BigValue) - i + 1, 1))
Values2(i) = Val(Mid(SmallValue, Len(SmallValue) - i + 1, 1))
OkValues(i) = OkValues(i) + Values1(i) - Values2(i)
If OkValues(i) ＜ 0 And i ＜ Len(BigValue) Then
OkValues(i + 1) = OkValues(i + 1) - 1
OkValues(i) = OkValues(i) + 10
End If
Next i
For i = Len(BigValue) To 1 Step -1
If OkValues(i) ＜＞ 0 Then
Limit = i
Exit For
End If
Next i
DecFunction = ""
For i = 1 To Limit
DecFunction = Trim(OkValues(i)) & DecFunction
Next i
If OverZero = True Then DecFunction = "-" & DecFunction
If DecFunction = "" Then DecFunction = "0"
End Function
Public Function SubFunction(Value1 As String, Value2 As String) As String '長整數相乘
Dim Code1(100) As Integer
Dim Code2(100) As Integer
Dim Code3(201) As Integer
Dim Steps1 As Integer
Dim Steps2 As Integer
Dim Subtotal As Integer
ii = Len(Value1)
jj = Len(Value2)
Steps1 = 0
For i = ii To 1 Step -1
Steps1 = Steps1 + 1
Code1(Steps1) = Val(Mid(Value1, i, 1))
Steps2 = 0
For j = jj To 1 Step -1
Steps2 = Steps2 + 1
Code2(Steps2) = Val(Mid(Value2, j, 1))
Code3(Steps1 + Steps2 - 1) = Code3(Steps1 + Steps2 - 1) + (Code1(Steps1) * Code2(Steps2))
If Code3(Steps1 + Steps2 - 1) ＞= 10 Then
u = Code3(Steps1 + Steps2 - 1) \ 10
Code3(Steps1 + Steps2 - 1) = Code3(Steps1 + Steps2 - 1) - u * 10
Code3(Steps1 + Steps2) = Code3(Steps1 + Steps2) + u
End If
Next j
Next i
For a = 1 To ii + jj - 1
If Code3(a) ＞= 10 Then
u = Code3(a) \ 10
Code3(a + 1) = Code3(a + 1) + u
Code3(a) = Code3(a) - u * 10
End If
Next a
SubFunction = ""
If Code3(ii + jj) ＜＞ 0 Then t = ii + jj Else t = ii + jj - 1
For i = t To 1 Step -1
SubFunction = SubFunction + Trim(Code3(i))
Next i
If SubFunction = "" Then SubFunction = "0"
End Function
Public Function DivFunction(Value1 As String, Value2 As String) As String '長整數相加
Dim MaxLen As Integer
If Len(Value1) ＞= Len(Value2) Then MaxLen = Len(Value1) Else MaxLen = Len(Value2)
If DivFunction = "" Then DivFunction = "0"
End Function
文章標籤
全站熱搜
'函數使用限制：第一個數必須比第二個數位數多 '輸入字串中若含有非數字，該字元自動以零計算 Public Function AddFunc(in1 As String, in2 As String) As String Dim strOutTemp As String '儲存結果的暫存變數 Dim lngCarry As Long Dim i As Long in1 = StrReverse(in1) '將兩個字串反轉，以便從個位數相加 in2 = StrReverse(in2) For i = 1 To Len(in1) lngCarry = lngCarry + Val(Mid(in1, i, 1)) + Val(Mid(in2, i, 1)) strOutTemp = Right(Str(lngCarry), 1) & strOutTemp '結合計算結果 lngCarry = Int(lngCarry / 10) '取得進位 Next i AddFunc = strOutTemp '傳回結果值 End Function 後記：看到包爺的留言，心想以前見過這個問題，總是不曾真的寫看看！ 剛剛寫完，看著程式笑了，不知自己是天才還是白痴... 看到一篇留言---花了一個小時....
參考參考 '加法 Private Function StrAdd(ByVal Str1 As String, ByVal Str2 As String) As String Dim i As Integer Dim Temp1 As Integer Dim Temp2 As Integer If Len(Str1) ＞ Len(Str2) Then Str2 = String(Len(Str1) - Len(Str2), "0") & Str2 Else Str1 = String(Len(Str2) - Len(Str1), "0") & Str1 End If For i = Len(Str1) To 1 Step -1 Temp1 = Asc(Mid(Str1, i, 1)) + Asc(Mid(Str2, i, 1)) + Temp2 - &H60 StrAdd = Format(Temp1 Mod 10, "0") & StrAdd Temp2 = Temp1 \ 10 Next If Temp2 ＜＞ 0 Then StrAdd = Format(Temp2, "0") & StrAdd End If End Function '減法 Private Function StrDec(ByVal Str1 As String, ByVal Str2 As String, Optional Recu As Boolean = False) As String Dim i As Integer Dim j As Integer Dim Temp1 As Integer Dim Temp2 As Integer Dim Sign As String If Str1 = Str2 Then StrDec = "0" Else If Not Recu Then Select Case True Case Len(Str1) ＞ Len(Str2) Str2 = String(Len(Str1) - Len(Str2), "0") & Str2 Case Len(Str1) = Len(Str2) For i = 1 To Len(Str1) Select Case True Case Mid(Str1, i, 1) ＞ Mid(Str2, i, 1) Exit For Case Mid(Str1, i, 1) ＜ Mid(Str2, i, 1) Sign = "-" Exit For End Select Next Case Len(Str1) ＜ Len(Str2) Sign = "-" Str1 = String(Len(Str2) - Len(Str1), "0") & Str1 End Select End If If Sign = "-" Then StrDec = "-" & StrDec(Str2, Str1, True) Else For i = Len(Str1) To 1 Step -1 Temp1 = (Asc(Mid(Str1, i, 1)) - Asc(Mid(Str2, i, 1))) + Temp2 If Temp1 ＜ 0 Then StrDec = Format(10 + Temp1, "0") & StrDec Temp2 = -1 Else StrDec = Format(Temp1, "0") & StrDec Temp2 = 0 End If Next For i = 1 To Len(Str1) If Mid(StrDec, i, 1) ＜＞ "0" Then Exit For End If Next StrDec = Right(StrDec, Len(StrDec) - i + 1) End If End If End Function '乘法不知道放哪裡去了，一時找不到
http://www.vbweb.co.uk/code/downloads/cparser.zip 這裡有一個範例, 有source code, 有興趣的可以去抓下來參考! 可以 + - / * ^ ! ( )
呵呵...有意思喔...越看越有意思... 只是突然覺得要是有類似c 語言的指標可以用就更方便了.. watch me 你的加法程式很不錯喔... 效率一定比我的好...也除去了我的一個限制和bug 除法很難寫嗎？怎麼都沒有阿... 對了...阿虹..謝謝你介紹的網站...可是那個程式不是介紹'長整數'的喔.. 包爺...看來你很成功的引起大家的興趣囉... 這兩天沒事我再來繼續努力... 哈哈...見笑囉...
天啊,真是五花八門...原來大家都研究這 小p有寫除法(不過是16進) 要的人可以E_Mail給我~~~^_^
'用途說明：65535位數以內的長整數相減 '使用限制：第一個數必須比第二個數大 Public Function SubtractFunc(strIn1 As String, strIn2 As String) As String '輸入字串中若含有非數字，該字元自動以零計算 Dim strOutTemp As String '儲存結果的暫存變數 Dim lngCarry As Long Dim i As Long strIn1 = StrReverse(strIn1) '將兩個字串反轉，以便從個位數相減 strIn2 = StrReverse(strIn2) For i = 1 To Len(strIn1) lngCarry = Val(Mid(strIn1, i, 1)) - Val(Mid(strIn2, i, 1)) + (lngCarry ＜ 0) strOutTemp = Trim(Str(lngCarry + (lngCarry ＜ 0) * (-10))) & strOutTemp '結合計算結果 Next i SubtractFunc = strOutTemp '傳回結果值 End Function 嘿嘿...這一次進步囉...只花了半小時... peter 我有寄信給你喔...
'把我的乘法公開，大家參考參考吧！這個演算方法不知道有沒有被別人申請專利去了，如果沒有，應該還有更好的演算方式吧！ Private Function StrMul(ByVal Str1 As String, ByVal Str2 As String) As String Dim I1 As Integer Dim I2 As Integer Dim L1 As Integer Dim L2 As Integer Dim L3 As Integer Dim OvFl1 As Integer Dim OvFl2 As Integer Dim TmpI As Integer L1 = Len(Str1) L2 = Len(Str2) L3 = L1 + L2 ReDim A1(L1) As Integer ReDim A2(L2) As Integer For I1 = 1 To L1 A1(I1) = Asc(Mid(Str1, L1 - I1 + 1, 1)) And &HF Next For I1 = 1 To L2 A2(I1) = Asc(Mid(Str2, L2 - I1 + 1, 1)) And &HF Next ReDim M(L3) As Integer For I1 = 1 To L1 For I2 = 1 To L2 M(I1 + I2 - 1) = M(I1 + I2 - 1) + (A1(I1) * A2(I2)) Next Next For I1 = 1 To L3 - 1 M(I1 + 1) = M(I1 + 1) + (M(I1) \ 10) StrMul = Format(M(I1) Mod 10, "0") & StrMul Next StrMul = Format(M(I1), "#") & StrMul End Function
'除法，有用到前面的加法跟減法，唉！這什麼鳥方法！ Public Sub StrDiv(ByVal Str1 As String, ByVal Str2 As String, ByVal Dec As Integer, Ans1 As String, Ans2 As String) Str1 = Str1 & String(Dec, "0") Ans1 = "0" Do Str1 = StrDec(Str1, Str2) If Left(Str1, 1) = "-" Then If Dec ＞ 0 Then Ans2 = "" Ans1 = Left(Ans1, Len(Ans1) - Dec) & "." & Right(Ans1, Dec) Else Ans2 = StrDec(Str2, Right(Str1, Len(Str1) - 1)) End If Exit Do Else Ans1 = StrAdd(Ans1, "1") End If Loop End Sub
呵呵...watch me...粉厲害優... 你的乘法寫的粉好也...
建議包仔不妨將函數裡的程式碼予以中文註解，並將變數部份按照標準命名方式，然後寄給紀文和 供後來者參考。
'改良版的除法，還是不太理想，不過速度上保證比前面的那個快多了， '運算時間取決於商的位數，而不是前一版的商的大小。商要帶小數的部分， '目前仍然沒有做到四捨五入，但是我覺得似乎不是很必要。 '有興趣的自己加上四捨五入的部分看看吧。 '參數說明： ' Str1 被除數 ' Str2 除數 ' Dec 小數位數 ' Ans1 商 ' Ans2 餘(如果有指定小數位數，則此處傳回長度0的字串) Private Sub StrDiv(ByVal Str1 As String, ByVal Str2 As String, ByVal Dec As Long, Ans1 As String, Ans2 As String) Dim TempStr As String Dim HiStr As String Dim LoStr As String Dim Pow As Long If Dec ＜ 0 Then Dec = 0 Str1 = Str1 & String(Dec, "0") If Len(Str1) ＜ Len(Str2) Then Ans1 = String(Dec + 1, "0") Ans2 = "0" Else TempStr = Left(Str1, Len(Str2)) Str1 = Right(Str1, Len(Str1) - Len(Str2)) Do TempStr = StrDec(TempStr, Str2) If TempStr = "0" Then Ans1 = StrAdd(Ans1, "1") If Len(Str1) = 0 Then Ans2 = "" Exit Do Else Ans1 = Ans1 & "0" TempStr = Left(Str1, 1) Str1 = Right(Str1, Len(Str1) - 1) End If ElseIf Left(TempStr, 1) = "-" Then If Len(Str1) = 0 Then Ans2 = StrDec(Str2, Right(TempStr, Len(TempStr) - 1)) Exit Do Else Ans1 = Ans1 & "0" TempStr = StrDec(Str2, Right(TempStr, Len(TempStr) - 1)) If TempStr = "0" Then TempStr = Left(Str1, 1) Else TempStr = TempStr & Left(Str1, 1) End If Str1 = Right(Str1, Len(Str1) - 1) End If Else Ans1 = StrAdd(Ans1, "1") End If Loop End If If Dec ＞ 0 Then Ans2 = "" Ans1 = Left(Ans1, Len(Ans1) - Dec) & "." & Right(Ans1, Dec) End If End Sub
補充說明！四捨五入的部分其實只要增加三行就可以做到了喔！大家動動腦吧！