OPERAR CON ENTEROS GRANDES EN EXCEL

Página inicial

 

 

 

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:

(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:

  1. Ponerle a la celda formato de texto (Formato -> Celdas -> solapa 'Número' -> Texto)

  2. 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

 

 

 

 

Página inicial