這可是包仔寫很久才寫出來的
提出來與大家分享
至於除法嘛...我還沒寫出來
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
創作者介紹

小吳 VBQA 程式設計討論

vbqa 發表在 痞客邦 PIXNET 留言(12) 人氣()


留言列表 (12)

發表留言
  • Alex
  • '函數使用限制:第一個數必須比第二個數位數多
    '輸入字串中若含有非數字,該字元自動以零計算
    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
    後記:看到包爺的留言,心想以前見過這個問題,總是不曾真的寫看看!
    剛剛寫完,看著程式笑了,不知自己是天才還是白痴...
       看到一篇留言---花了一個小時....
  • Watch Me
  • 參考參考
    '加法
    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
    '乘法不知道放哪裡去了,一時找不到
  • Alex
  • 呵呵...有意思喔...越看越有意思...
    只是突然覺得要是有類似c 語言的指標可以用就更方便了..
    watch me 你的加法程式很不錯喔...
    效率一定比我的好...也除去了我的一個限制和bug
    除法很難寫嗎?怎麼都沒有阿...
    對了...阿虹..謝謝你介紹的網站...可是那個程式不是介紹'長整數'的喔..
    包爺...看來你很成功的引起大家的興趣囉...
    這兩天沒事我再來繼續努力...
    哈哈...見笑囉...
  • Peter
  • 天啊,真是五花八門...原來大家都研究這
    小p有寫除法(不過是16進)
    要的人可以E_Mail給我~~~^_^
  • Alex
  • '用途說明: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 我有寄信給你喔...
  • Watch Me
  • '把我的乘法公開,大家參考參考吧!這個演算方法不知道有沒有被別人申請專利去了,如果沒有,應該還有更好的演算方式吧!
    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
  • Watch Me
  • '除法,有用到前面的加法跟減法,唉!這什麼鳥方法!
    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
  • Alex
  • 呵呵...watch me...粉厲害優...
    你的乘法寫的粉好也...
  • SPENCER YANG
  • 建議包仔不妨將函數裡的程式碼予以中文註解,並將變數部份按照標準命名方式,然後寄給紀文和
    供後來者參考。
  • 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
  • Watch Me
  • 補充說明!四捨五入的部分其實只要增加三行就可以做到了喔!大家動動腦吧!