Lo primero que conviene dejar claro sobre este tema es que ni VBA es el lenguaje de programación más apropiado para trabajar con números enteros muy grandes, ni una hoja de cálculo como Excel es el sitio más adecuado para almacenarlos. Seguro que existen herramientas y soportes mucho más especializados.
A pesar de lo anterior, hace algún tiempo tuve la necesidad de operar con números enteros grandes en Excel, en concreto sumas, restas y multiplicaciones de enteros que daban como resultado enteros de más de cien dígitos, y la única forma que se me ocurrió de conseguirlo fue mediante la imitación en VBA de los métodos que usamos para hacer estas operaciones básicas a mano, para lo que escribí las funciones para la suma, la sustracción y el producto.
Pero la solución de esta necesidad trajo como consecuencia que mi curiosidad "se excitara" y me hiciera preguntarme: "¿y hasta dónde se podría llegar en Excel?". Así que, basándome en las funciones para esas tres operaciones básicas (suma, resta y multiplicación), he escrito también funciones para:
hallar el factorial de un número grande (he llegado hasta 3000! −el signo de cierre de exclamación significa factorial−, que es un entero de 9.131 dígitos cuya suma de dígitos es 37.602)
encontrar un número alto de la serie Fibonacci (he llegado hasta el 9999 de la serie, que es un entero de 2.090 dígitos cuya suma es 9.385)
averiguar una potencia grande de un número (he llegado hasta 2^35000, que es un entero de 10.537 dígitos cuya suma es 47.470)
hallar el primorial de un número grande (he llegado hasta 19.997# −el símbolo # significa primorial−, que es un entero de 8.602 dígitos cuya suma es 38.715)
(pongo la cantidad de dígitos y sus sumas por si alguien estuviese en disposición de verificar estos resultados y para que en caso de no ser correctos hiciese el favor de notificármelo a excel_jrgc ARROBA yahoo.es)
Conviene recordar que para poder situar en una celda de Excel un número de más de 15 dígitos sin que el número vea convertidos en ceros todos sus dígitos a partir del decimoquinto tenemos dos opciones:
Ponerle a la celda formato de texto (Formato -> Celdas -> solapa 'Número' -> Texto)
Anteponer al número un apóstrofo '
Todas las funciones expuestas a continuación devuelven sus resultados numéricos como cadenas de texto para evitar la conversión a ceros descrita.
Hay disponible un libro con un ejemplo del uso de cada una de estas funciones.
La primera función es, lógicamente, la correspondiente a la suma, cuyo código es:
Public Function SumaGR(ParamArray mtrR() As Variant) As String 'Sintaxis: =SumaGR(Rango o celda a sumar; Rango o celda a sumar; ... ; Rango o celda a sumar) 'Esta función suma enteros positivos grandes (si se le pasan números negativos y/o con decimales _ se producirá un error) Dim IteradorR As Variant Dim rngA As Range, rngC As Range Dim sResultado As String Dim mtr() As String Dim iLargo As Integer, iSuma As Integer Dim n As Integer, k As Integer 'Llenar mtr() n = 1 'Se utilizará esta variable para llenar la matriz mtr For Each IteradorR In mtrR() For Each rngA In IteradorR.Areas For Each rngC In rngA If rngC.Value <> "" And (WorksheetFunction.IsText(rngC.Value) Or WorksheetFunction.IsNumber(rngC.Value)) Then If Not TodoNúmeros(rngC.Value) Then SumaGR = "Alguno de los argumentos pasados a la funcion SumaGR tiene decimales o no es un entero positivo." Exit Function End If ReDim Preserve mtr(n) mtr(n) = IIf(WorksheetFunction.IsText(rngC.Value), rngC.Value, CStr(rngC.Value)) iLargo = WorksheetFunction.Max(iLargo, Len(mtr(n))) n = n + 1 End If Next rngC Next rngA Next IteradorR 'Igualar las longitudes en mtr() For n = 1 To UBound(mtr) If Len(mtr(n)) < iLargo Then mtr(n) = WorksheetFunction.Rept("0", iLargo - Len(mtr(n))) & mtr(n) Next n For n = iLargo To 1 Step -1 For k = 1 To UBound(mtr) iSuma = iSuma + CInt(Mid(mtr(k), n, 1)) Next k sResultado = Right(CStr(iSuma), 1) & sResultado If Len(CStr(iSuma)) > 1 Then iSuma = CInt(Left(CStr(iSuma), Len(CStr(iSuma)) - 1)) Else iSuma = 0 End If Next n SumaGR = IIf(iSuma > 0, CStr(iSuma), "") & sResultado End Function
La función anterior hace uso de una auxiliar, llamada TodoNúmeros, que sirve para verificar que todos los caracteres de las cadenas de texto son números y prevenir así posibles errores. El código de esta función auxiliar es:
Private Function TodoNúmeros(ByVal sCad As String) As Boolean 'Esta función devuelve el valor lógico TRUE si todos los caracteres de sCad son _ númericos, y FALSE en caso contrario Dim n As Integer For n = 1 To Len(sCad) If Asc(Mid(sCad, n, 1)) < 48 Or Asc(Mid(sCad, n, 1)) > 57 Then TodoNúmeros = False Exit Function End If Next n TodoNúmeros = True End Function
La segunda función es la correspondiente a la resta o sustracción:
Public Function RestaGR(ByVal sMinuendo As String, ByVal sSustraendo As String) As String 'Sintaxis: =RestaGR(Minuendo;Sustraendo) 'Nota: si Sustraendo < Minuendo, la función lo notificará. If Comparar(sMinuendo, sSustraendo) = 2 Then RestaGR = "El sustraendo no puede ser menor que el minuendo." Exit Function End If Dim mtr() As Byte Dim iMi As Integer, iSu As Integer Dim n As Integer If Not TodoNúmeros(sMinuendo) Or Not TodoNúmeros(sSustraendo) Then RestaGR = "Alguno de los argumentos pasados a la funcion SumaGR tiene decimales, caracteres no numéricos o no es un entero positivo." Exit Function End If 'Igualar las longitudes sSustraendo = WorksheetFunction.Rept("0", Len(sMinuendo) - Len(sSustraendo)) & sSustraendo ReDim mtr(1 To Len(sMinuendo)) 'Proceso For n = Len(sMinuendo) To 1 Step -1 iMi = CInt(Mid(sMinuendo, n, 1)) iSu = CInt(Mid(sSustraendo, n, 1)) + mtr(n) If iMi < iSu Then mtr(n - 1) = 1 RestaGR = Right(CStr(iSu - iMi - 10), 1) & RestaGR Next n 'Quitar ceros a la izquierda Do If Left(RestaGR, 1) = "0" Then RestaGR = Right(RestaGR, Len(RestaGR) - 1) Else Exit Do End If Loop End Function
Esta función hace uso de una auxiliar para poder comparar las cadenas de texto:
Private Function Comparar(ByVal sCad1 As String, ByVal sCad2 As String) As Integer 'Devolverá 0 si sCad1 = sCad2, 1 si sCad1 > sCad2 y 2 si sCad1 < sCad2 'Quitar posibles ceros a la izquierda Dim n As Integer For n = 1 To Len(sCad1) If Left(sCad1, 1) = "0" Then sCad1 = Right(sCad1, Len(sCad1) - 1) Else Exit For Next n For n = 1 To Len(sCad2) If Left(sCad2, 1) = "0" Then sCad2 = Right(sCad2, Len(sCad2) - 1) Else Exit For Next n 'Si las 2 cadenas tienen longitudes diferentes... If Len(sCad1) <> Len(sCad2) Then If Len(sCad1) > Len(sCad2) Then Comparar = 1 Else Comparar = 2 Exit Function End If 'Si ambas cadenas tienen la misma longitud For n = 1 To Len(sCad1) If Mid(sCad1, n, 1) > Mid(sCad2, n, 1) Then Comparar = 1 Exit Function ElseIf Mid(sCad1, n, 1) < Mid(sCad2, n, 1) Then Comparar = 2 Exit Function End If Next n 'Si el valor de ambas cadenas es el mismo, la función devuelve 0 End Function
y hace uso también de la función TodoNúmeros que se expuso más arriba como función auxiliar de SumaGR
La última función es la encargada del producto o multiplicación de dos enteros:
Public Function ProductoGR(a As String, b As String) As String 'Sintaxis: =ProductoGR(Multiplicando; Multiplicador) 'Esta función multiplica 2 enteros grandes Dim sResultado As String Dim sMndo As String, sMdor As String, bMult As Byte, bAcarreo As Byte, iMaxLen As Integer Dim n As Long, k As Long Dim mtr() As String If Len(a) > Len(b) Then sMndo = a sMdor = b Else sMndo = b sMdor = a End If ReDim mtr(1 To WorksheetFunction.Min(Len(sMndo), Len(sMdor))) As String For n = Len(sMdor) To 1 Step -1 bAcarreo = 0 For k = Len(sMndo) To 1 Step -1 bMult = CByte(Mid(sMdor, n, 1) * CByte(Mid(sMndo, k, 1))) + bAcarreo sResultado = Right(CStr(bMult), 1) & sResultado If bMult > 9 Then bAcarreo = CByte(Left(bMult, 1)) Else bAcarreo = 0 End If Next k If bAcarreo > 0 Then sResultado = CStr(bAcarreo) & sResultado mtr(Len(sMdor) - n + 1) = sResultado If n < Len(sMdor) Then mtr(Len(sMdor) - n + 1) = mtr(Len(sMdor) - n + 1) & WorksheetFunction.Rept("0", Len(sMdor) - n) End If If Len(mtr(Len(sMdor) - n + 1)) > iMaxLen Then iMaxLen = Len(mtr(Len(sMdor) - n + 1)) sResultado = "" Next n For n = 1 To UBound(mtr) mtr(n) = Right(WorksheetFunction.Rept("0", iMaxLen) & mtr(n), iMaxLen) Next n ProductoGR = s_mtr(mtr()) End Function
La función anterior utiliza una función auxiliar para sumar la matriz de strings:
Private Function s_mtr(mtr() As String) As String 'Esta función requiere como argumento una matriz de strings, por lo que no es posible _ usarla directamente desde una hoja de cálculo. 'Devuelve la suma de los elementos de la matriz de strings Dim sResultado As String Dim iLargo As Integer, iSuma As Integer Dim n As Integer, k As Integer iLargo = Len(mtr(1)) For n = iLargo To 1 Step -1 For k = 1 To UBound(mtr) iSuma = iSuma + CInt(Mid(mtr(k), n, 1)) Next k sResultado = Right(CStr(iSuma), 1) & sResultado If Len(CStr(iSuma)) > 1 Then iSuma = CInt(Left(CStr(iSuma), Len(CStr(iSuma)) - 1)) Else iSuma = 0 End If Next n s_mtr = IIf(iSuma > 0, CStr(iSuma), "") & sResultado End Function
Con las funciones anteriores estamos en disposición de realizar tres de las cuatro operaciones básicas (suma, resta y multiplicación), lo que hace posible desarrollar algunas otras funciones que hacen cosas más específicas.
Comenzaremos por una función para averiguar el factorial de un entero grande:
Public Function FactorialGR(iNúmero As Integer) As String 'Esta función devuelve el factorial del número que se le pasa como argumento. 'Sintaxis: =FactorialGR(Número) Dim sResultado As String Dim n As Integer sResultado = CStr(1) For n = 2 To iNúmero sResultado = ProductoGR(sResultado, CStr(n)) Next n FactorialGR = sResultado End Function
Puede verse en el código que esta función necesita de la función ProductoGR, que a su vez hace uso de la función s_mtr
Ahora viene la función para hallar un número de la serie Fibonacci:
Public Function FibonacciGR(ByVal iSerie As Integer) As String 'Esta función devuelve el número de la serie Fibonacci que se le pasa como argumento. 'Sintaxis: =FibonacciGR(Número) If iSerie < 2 Then FibonacciGR = CStr(iSerie) Exit Function ElseIf iSerie = 2 Then FibonacciGR = "1" Exit Function End If Dim mtr(2) As String Dim sResultado As String Dim i_N As Integer On Error GoTo captura mtr(1) = 1: mtr(2) = 1 For i_N = 3 To iSerie If Len(mtr(1)) < Len(mtr(2)) Then mtr(1) = WorksheetFunction.Rept("0", Len(mtr(2)) - Len(mtr(1))) & mtr(1) End If sResultado = s_mtr(mtr()) mtr(1) = mtr(2) mtr(2) = sResultado Next i_N FibonacciGR = sResultado Exit Function captura: FibonacciGR = Err.Number & "-" & Err.Description End Function
Esta función hace uso de la función s_mtr
También es posible hallar el primorial de un número grande mediante esta función:
Public Function PrimorialGR(ByVal lNúmero As Long) As String 'Esta función devuelve el primorial de un número entero positivo (si el número no es primo, la función devolverá _ el primorial del primo inmediatamente anterior al número) 'Sintaxis: =PrimorialGR(Número) If lNúmero < 0 Then PrimorialGR = "Esta función admite sólo números enteros positivos." Exit Function End If If lNúmero < 3 Then PrimorialGR = CStr(lNúmero) Exit Function End If Dim a() As Boolean 'Matriz de trabajo Dim lTope As Long Dim lIterar1 As Long, lIterar2 As Long Dim lFila As Long, btCol As Byte lTope = lNúmero
ReDim a(1 To lTope) lFila = 2 btCol = 1 'Tamiz de Eratóstenes For lIterar1 = 3 To lTope Step 2 If Not a(lIterar1) Then For lIterar2 = lIterar1 ^ 2 To lTope Step lIterar1 a(lIterar2) = True Next lIterar2 End If Next lIterar1 'Cálculo PrimorialGR = "2" For lIterar1 = 3 To lTope Step 2 If Not a(lIterar1) Then PrimorialGR = ProductoGR(PrimorialGR, CStr(lIterar1)) End If Next lIterar1 End Function
que hace uso de la función ProductoGR, la cual a su vez necesita la función auxiliar s_mtr
Finalmente veremos la función para averiguar el resultado de elevar un entero a una potencia:
Public Function PotenciaciónGR(ByVal sNúmero As String, ByVal crPotencia As Currency) As String 'Calcula Número ^ Potencia 'Sintaxis: =PotenciaciónGR(Número; Potencia) 'Esta función requiere la función ProductoGR Dim n As Currency PotenciaciónGR = 1 For n = 1 To crPotencia PotenciaciónGR = ProductoGR(PotenciaciónGR, sNúmero) Next n End Function