[Aporte] Super Calculadora

Option Explicit
 
Dim num1, num2, n, m, x, op, r,v
 
num2 = inputbox("Introduce El Primer Numero")'"123654789"
num1 = inputbox("Introduce Segundo Numero")'"147852369"
 
ReDim n(Len(num1)), m(Len(num2))
 
For x = 1 To Len(num1)
   n(x) = CInt(Mid(num1, x, 1))
Next
 
For x = 1 To Len(num2)
   m(x) = CInt(Mid(num2, x, 1))
Next
 
op = InputBox("1- Sumar" & vbCrLf & "2- Restar" & vbCrLf & "3- Multiplicar" & vbCrLf & "4- Dividir")
 
Select Case op
   Case "1"
      r = sumar(n, m)
   Case "2"
      r = RestaroDividir(n, m, op)
   Case "3"
      v = mmi(num1,num2)
      if v = "+" then
	     r = multiplicar(n,m)
	  elseif v = "-" then
         r = multiplicar(m, n)
      else
	     r = multiplicar(n, m)
	  end if      
   Case "4"
      r = RestaroDividir(n, m, op)
End Select
MsgBox r
r = Replace(r, " ", "")
 
Function Dividir(n, m)
On Error Resume Next
   Dim num1, num2, pf, d, x, s, j, r, mk
 
   num1 = Replace(Join(n), " ", "")
   num2 = Replace(Join(m), " ", "")
 
   pf = UBound(m)
 
   d = Mid(num1, 1, pf)
 
   While pf <= UBound(n)  'pf
 
      Select Case mmi(d, num2)
         Case "+"
            x = "0"
            s = "0"
            ReDim md(Len(d))
            For j = 1 To Len(d)
               md(j) = Mid(d, j, 1)
            Next
            While mmi(s, d) = "-"
               x = CStr(CDbl(x) + 1)
 
               ReDim mx(Len(x))
               ReDim ms(Len(num2))
 
               For j = 1 To Len(num2)
                  ms(j) = Mid(num2, j, 1)
               Next
 
               For j = 1 To Len(x)
                  mx(j) = Mid(x, j, 1)
               Next
               s = Replace(multiplicar(ms, mx), " ", "")
            Wend
            If mmi(s, d) <> "1" Then
                x = CStr(CDbl(x) - 1)
            End If
 
               ReDim mx(Len(x))
 
               For j = 1 To Len(x)
                  mx(j) = Mid(x, j, 1)
               Next
 
               mk = Split(multiplicar(mx, m), " ")
 
               d = Replace(RestaroDividir(mk, md, "2"), " ", "")
               While Mid(d, 1, 1) = "0"
                  d = Mid(d, 2, Len(d))
               Wend
 
               r = r & x
 
              pf = pf + 1
              d = d & n(pf)
 
         Case "-"
            r = r & "0"
            pf = pf + 1
            d = d & n(pf)
         Case "1"
            r = r & "1"
            pf = pf + 1
            d = n(pf)
      End Select
   Wend
   While Mid(r, 1, 1) = "0"
      r = Mid(r, 2, Len(r))
   Wend
   Dividir = "Caben:-" & r & "----Sobran:-" & d
End Function
 
Function mmi(num1, num2)
   Dim x, r
 
   While Mid(num1, 1, 1) = "0"
      num1 = Mid(num1, 2, Len(num1))
   Wend
   While Mid(num2, 1, 1) = "0"
      num2 = Mid(num2, 2, Len(num2))
   Wend
 
   If Len(num1) > Len(num2) Then
      r = "+"
   ElseIf Len(num1) = Len(num2) Then
      For x = 1 To Len(num1)
         If CInt(Mid(num1, x, 1)) > CInt(Mid(num2, x, 1)) Then
            r = "+"
            Exit For
         ElseIf CInt(Mid(num1, x, 1)) < CInt(Mid(num2, x, 1)) Then
            r = "-"
            Exit For
         End If
      Next
   Else
      r = "-"
   End If
 
   If (x - 1) = Len(num1) Then
      mmi = "1"
   Else
      mmi = r
   End If
End Function
'-------------------------------------------------------------------------------------------------------------'
Function RestaroDividir(n, m, op)
   Dim lm, ln, r, x
 
   ln = UBound(n)
   lm = UBound(m)
 
   If ln > lm Then
      r = rd(n, m, op)
   ElseIf ln < lm Then
      r = rd(m, n, op)
   Else
      For x = 1 To UBound(n)
         If n(x) > m(x) Then
             r = rd(n, m, op)
             Exit For
         ElseIf n(x) < m(x) Then
             r = rd(m, n, op)
             Exit For
         End If
      Next
   End If
 
   If r = "" Then
      If op = "2" Then
         RestaroDividir = "0"
      Else
         RestaroDividir = "1"
      End If
   Else
      RestaroDividir = r
   End If
End Function
 
Function rd(n, m, op)
   Dim ln, lm, r
 
   If op = "2" Then
      ln = UBound(n)
      lm = UBound(m)
      r = Restar(ln, lm, n, m)
   Else
      r = Dividir(n, m)
   End If
   rd = r
End Function
'-------------------------------------------Funcion Multiplica---------------------------------------------------'
Function multiplicar(n, m)
   Dim x, y, r, c, s
 
   ReDim a(UBound(m))
 
   For x = UBound(a) To 1 Step -1
      r = Join(n)
      s = Split(r, " ")
      For y = 2 To CInt(m(x))
         r = sumar(n, s)
         s = Split(r, " ")
      Next
      a(x) = r & c
      c = c & " 0"
   Next
 
   s = Split(a(1), " ")
 
   For x = 2 To UBound(a)
      c = Split(a(x), " ")
      r = sumar(s, c)
      s = Split(r, " ")
   Next
   multiplicar = r
End Function
'---------------------------------------------Funcion Restar-------------------------------------------------------'
Function Restar(ln, lm, n, m)
   Dim x, r, a
 
   For x = ln To 1 Step -1
      If lm > 0 Then
         If CInt(n(x)) >= CInt(m(lm)) Then
            r = CStr(n(x) - m(lm)) & " " & r
         Else
            r = CStr(n(x) - m(lm) + 10) & " " & r
            For a = x - 1 To 1 Step -1
               If n(a) = 0 Then
                  n(a) = 9
               Else
                  n(a) = n(a) - 1
                  Exit For
               End If
            Next
         End If
      Else
         r = CStr(n(x)) & " " & r
      End If
      lm = lm - 1
   Next
   While Mid(r, 1, 1) = "0"
         r = Mid(r, 2, Len(r))
   Wend
   Restar = Trim(r)
End Function
'-----------------------------------------Funcion Sumar--------------------------------------------------------------------'
Function sumar(n, m)
   Dim lm, ln, r
 
   ln = UBound(n)
   lm = UBound(m)
 
   If ln >= lm Then
      r = s(ln, lm, n, m)
   Else
      r = s(lm, ln, m, n)
   End If
   sumar = r
End Function
 
Function s(ln, lm, n, m)
   Dim a, b, x, r
   a = 0
   For x = ln To 1 Step -1
      If lm > 0 Then
         a = CInt(n(x)) + CInt(m(lm)) + a
         If a > 9 Then
            b = CStr(a)
            r = Mid(b, 2, 1) & " " & r
            a = CInt(Mid(b, 1, 1))
         Else
            r = CStr(a) & " " & r
            a = 0
         End If
      Else
         a = CInt(n(x)) + a
         If a > 9 Then
            b = CStr(a)
            r = Mid(b, 2, 1) & " " & r
            a = CInt(Mid(b, 1, 1))
         Else
            r = CStr(a) & " " & r
            a = 0
         End If
      End If
      lm = lm - 1
   Next
   If a > 0 Then
      r = CStr(a) & " " & r
   End If
   s = " " & Trim(r)
End Function