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