la idea me surgio al ver esta pagina: http://www.elguille.info/NET/dotnet/operarConNumerosGrandes1.htm
pero en algunas operaciones observe que no daba el resultado correcto así que hice la mía mejor
Nota: si ponen muy grandes tardara en hacer la operación
Aquí el code
Código
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
Saludos Flamer y me dicen si tiene errores para corregirlos