BigInteger em VBA no Excel

[Labrego]

Para implementar números inteiros gigantes no Excel em formato string, basta criar um módulo de classe com o seguinte conteúdo:

**************************************

Option Explicit

Private pValor As String

Public Property Get Valor() As String

Valor = pValor

End Property

Public Property Let Valor(ByVal Value As String)

If Value = K_VALOR_INDEFINIDO Then

pValor = Value

Else

pValor = FiltrarDigitos(Value)

End If

End Property

Public Property Get Sinal() As String

Sinal = Left(pValor, K_VALOR_UM)

End Property

Public Property Let Sinal(ByVal Value As String)

If Value = K_SINAL_POSITIVO Or Value = K_SINAL_NEGATIVO Then

pValor = Value + Mid(pValor, K_VALOR_DOIS)

End If

End Property

Public Property Get Digitos() As String

Digitos = Mid(pValor, 2)

End Property

Private Property Let Digitos(ByVal Value As String)

pValor = Left(pValor, K_VALOR_UM) + Value

End Property

Public Property Get ValorFormatado() As String

ValorFormatado = pValor

If Me.Sinal = K_SINAL_POSITIVO Then

ValorFormatado = Mid(ValorFormatado, 2)

End If

ValorFormatado = FormatarNumero(ValorFormatado)

End Property

Public Function Adicionar(ByRef Parcela As BigInteger) As BigInteger

Dim parcela1 As String, parcela2 As String, sinal1 As String, sinal2 As String, aux As String

parcela1 = Me.Digitos

sinal1 = Me.Sinal

parcela2 = Parcela.Digitos

sinal2 = Parcela.Sinal

If CompararNumeros(parcela1, parcela2) = K_SINAL_MENOR Then

aux = parcela1

parcela1 = parcela2

parcela2 = aux

aux = sinal1

sinal1 = sinal2

sinal2 = aux

End If

If sinal1 = sinal2 Then

Me.Valor = sinal1 + AdicionarNumeros(parcela1, parcela2)

Else

Me.Valor = sinal1 + SubtrairNumeros(parcela1, parcela2)

End If

Adicionar.Valor = Me.Valor

End Function

Private Function AdicionarNumeros(ByVal parcela1 As String, ByVal parcela2 As String) As String

Dim i As Long, qtdDigitos As Long, vaiUm As Byte, soma As Byte

AdicionarNumeros = K_STRING_VAZIA

If Len(parcela1) > Len(parcela2) Then

parcela2 = String(Len(parcela1) - Len(parcela2), K_ALGARISMO_ZERO) + parcela2

Else

parcela1 = String(Len(parcela2) - Len(parcela1), K_ALGARISMO_ZERO) + parcela1

End If

qtdDigitos = Len(parcela1)

vaiUm = K_VALOR_ZERO

For i = qtdDigitos To K_VALOR_UM Step -K_VALOR_UM

soma = CByte(Mid(parcela1, i, K_VALOR_UM)) + CByte(Mid(parcela2, i, K_VALOR_UM)) + vaiUm

If soma > K_VALOR_NOVE Then

soma = soma - K_VALOR_DEZ

vaiUm = K_VALOR_UM

Else

vaiUm = K_VALOR_ZERO

End If

AdicionarNumeros = CStr(soma) + AdicionarNumeros

Next

If vaiUm > K_VALOR_ZERO Then

AdicionarNumeros = CStr(vaiUm) + AdicionarNumeros

End If

End Function

Public Function Subtrair(ByRef Subtraendo As BigInteger) As BigInteger

Dim termo1 As String, termo2 As String, sinal1 As String, sinal2 As String, aux As String

termo1 = Me.Digitos

sinal1 = Me.Sinal

termo2 = Subtraendo.Digitos

sinal2 = Subtraendo.Sinal

If sinal2 = K_SINAL_POSITIVO Then

sinal2 = K_SINAL_NEGATIVO

Else

sinal2 = K_SINAL_POSITIVO

End If

If CompararNumeros(termo1, termo2) = K_SINAL_MENOR Then

aux = termo1

termo1 = termo2

termo2 = aux

aux = sinal1

sinal1 = sinal2

sinal2 = aux

End If

If sinal1 = sinal2 Then

Me.Valor = sinal1 + AdicionarNumeros(termo1, termo2)

Else

Me.Valor = sinal1 + SubtrairNumeros(termo1, termo2)

End If

Subtrair.Valor = Me.Valor

End Function

Private Function SubtrairNumeros(ByVal minuendo As String, ByVal Subtraendo As String) As String

Dim i As Long, qtdDigitos As Long, digito1 As Byte, digito2 As Byte, EmprestaUm As Byte, diferenca As Byte, aux As String

Subtraendo = String(Len(minuendo) - Len(Subtraendo), K_ALGARISMO_ZERO) + Subtraendo

SubtrairNumeros = K_STRING_VAZIA

qtdDigitos = Len(minuendo)

EmprestaUm = K_VALOR_ZERO

For i = qtdDigitos To K_VALOR_UM Step -K_VALOR_UM

digito1 = CByte(Mid(minuendo, i, K_VALOR_UM))

digito2 = CByte(Mid(Subtraendo, i, K_VALOR_UM)) + EmprestaUm

If digito1 < digito2 Then

digito1 = digito1 + K_VALOR_DEZ

EmprestaUm = K_VALOR_UM

Else

EmprestaUm = K_VALOR_ZERO

End If

diferenca = digito1 - digito2

SubtrairNumeros = CStr(diferenca) + SubtrairNumeros

Next

SubtrairNumeros = RetirarZerosNaoSignificativos(SubtrairNumeros)

End Function

Public Function Multiplicar(ByRef Fator As BigInteger) As BigInteger

Dim fator1 As String, fator2 As String, sinal1 As String

fator1 = Me.Digitos

fator2 = Fator.Digitos

If Me.Sinal = Fator.Sinal Then

sinal1 = K_SINAL_POSITIVO

Else

sinal1 = K_SINAL_NEGATIVO

End If

Me.Valor = sinal1 + MultiplicarNumeros(fator1, fator2)

Multiplicar.Valor = Me.Valor

End Function

Private Function MultiplicarNumeros(ByVal fator1 As String, ByVal fator2 As String) As String

Dim i As Long, j As Long, qtdDigitos1 As Long, qtdDigitos2 As Long, carry As Byte, produto As Byte, _

produtoParcial As String, zeros As String, digito1 As Byte, digito2 As Byte

MultiplicarNumeros = K_ALGARISMO_ZERO

qtdDigitos1 = Len(fator1)

qtdDigitos2 = Len(fator2)

zeros = K_STRING_VAZIA

For i = qtdDigitos2 To K_VALOR_UM Step -K_VALOR_UM

digito2 = CByte(Mid(fator2, i, K_VALOR_UM))

If digito2 = K_VALOR_ZERO Then

zeros = zeros + K_ALGARISMO_ZERO

Else

If digito2 = K_ALGARISMO_UM Then

produtoParcial = fator1

Else

carry = K_VALOR_ZERO

produtoParcial = K_STRING_VAZIA

For j = qtdDigitos1 To K_VALOR_UM Step -K_VALOR_UM

digito1 = CByte(Mid(fator1, j, K_VALOR_UM))

produto = digito2 * digito1 + carry

If produto > K_VALOR_NOVE Then

carry = Int(produto / K_VALOR_DEZ)

produto = produto Mod (carry * K_VALOR_DEZ)

Else

carry = K_VALOR_ZERO

End If

produtoParcial = CStr(produto) + produtoParcial

Next

If carry > K_VALOR_ZERO Then

produtoParcial = CStr(carry) + produtoParcial

End If

End If

produtoParcial = produtoParcial + zeros

zeros = zeros + K_ALGARISMO_ZERO

MultiplicarNumeros = AdicionarNumeros(MultiplicarNumeros, produtoParcial)

End If

Next

End Function

Public Function Dividir(ByRef Divisor As BigInteger, Optional ByRef Resto As BigInteger) As BigInteger

Dim termo1 As String, termo2 As String, sinal1 As String, diferenca As String, quociente As String, comparacao As String

termo2 = Divisor.Digitos

If CompararNumeros(termo2, K_ALGARISMO_ZERO) = K_SINAL_IGUAL Then

Dividir.Valor = K_VALOR_INDEFINIDO

Else

termo1 = Me.Digitos

If Me.Sinal = Divisor.Sinal Then

sinal1 = K_SINAL_POSITIVO

Else

sinal1 = K_SINAL_NEGATIVO

End If

comparacao = CompararNumeros(termo1, termo2)

If comparacao = K_SINAL_MENOR Then

Resto.Valor = Me.Valor

Me.Valor = K_ALGARISMO_ZERO

ElseIf comparacao = K_SINAL_IGUAL Then

Resto.Valor = K_ALGARISMO_ZERO

Me.Valor = sinal1 + K_ALGARISMO_UM

Else

quociente = sinal1 + DividirNumeros(termo1, termo2, diferenca)

Resto.Valor = Me.Sinal + diferenca

Me.Valor = quociente

End If

End If

Dividir.Valor = Me.Valor

End Function

Private Function DividirNumeros(ByVal dividendo As String, ByVal Divisor As String, ByRef Resto As String) As String

Dim quociente As Long, dividendoParcial As String, produto As String, tamanho As Long, comparacao As String, _

incremento As Long, comparador As String, produtoAnterior As String

DividirNumeros = K_STRING_VAZIA

tamanho = Len(Divisor)

produto = K_ALGARISMO_ZERO

Do While dividendo <> K_STRING_VAZIA

dividendoParcial = dividendoParcial + Left(dividendo, tamanho)

dividendo = Mid(dividendo, tamanho + K_VALOR_UM)

tamanho = K_VALOR_UM

If CompararNumeros(dividendoParcial, Divisor) <> K_SINAL_MENOR Then

quociente = K_VALOR_CINCO

Do

produtoAnterior = produto

produto = MultiplicarNumeros(Divisor, CStr(quociente))

comparacao = CompararNumeros(produto, dividendoParcial)

If quociente = K_VALOR_CINCO Then

If comparacao = K_SINAL_MENOR Then

comparador = K_SINAL_MENOR

incremento = K_VALOR_UM

ElseIf comparacao = K_SINAL_MAIOR Then

comparador = K_SINAL_MAIOR

incremento = -K_VALOR_UM

Else

Exit Do

End If

ElseIf comparacao <> comparador Then

If comparador = K_SINAL_MENOR Then

quociente = quociente - K_VALOR_UM

produto = produtoAnterior

End If

Exit Do

End If

quociente = quociente + incremento

Loop

dividendoParcial = SubtrairNumeros(dividendoParcial, produto)

DividirNumeros = DividirNumeros + CStr(quociente)

ElseIf DividirNumeros <> K_STRING_VAZIA Then

DividirNumeros = DividirNumeros + K_ALGARISMO_ZERO

End If

Loop

Resto = dividendoParcial

End Function

Public Function Potenciar(ByVal Expoente As Long) As BigInteger

Dim base As String, sinalBase As String, expoentePar As Boolean

If Expoente < K_VALOR_ZERO Then

Potenciar.Valor = K_VALOR_INDEFINIDO

Else

base = Me.Digitos

sinalBase = Me.Sinal

Me.Valor = PotenciarNumero(base, Expoente)

If Expoente Mod K_VALOR_DOIS = K_VALOR_ZERO Then

Me.Sinal = K_SINAL_POSITIVO

Else

Me.Sinal = sinalBase

End If

End If

Potenciar.Valor = Me.Valor

End Function

Private Function PotenciarNumero(ByVal base As String, ByVal Expoente As Long) As String

Dim potenciaParcial As String, expoenteParcial As Long, produto As String

PotenciarNumero = K_ALGARISMO_UM

expoenteParcial = K_VALOR_UM

potenciaParcial = base

Do While Expoente > K_VALOR_ZERO

produto = expoenteParcial * K_VALOR_DOIS

If produto > Expoente Then

PotenciarNumero = MultiplicarNumeros(PotenciarNumero, potenciaParcial)

Expoente = Expoente - expoenteParcial

expoenteParcial = K_VALOR_UM

potenciaParcial = base

Else

expoenteParcial = produto

potenciaParcial = MultiplicarNumeros(potenciaParcial, potenciaParcial)

End If

Loop

End Function

Public Function Radiciar(ByVal Indice As Long, Optional ByRef Resto As BigInteger) As BigInteger

Dim radicando As String, sinalRadicando As String, diferenca As String

If Indice <= K_VALOR_ZERO Then

Me.Valor = K_VALOR_INDEFINIDO

Else

radicando = Me.Digitos

sinalRadicando = Me.Sinal

IndicePar = (Indice Mod K_VALOR_DOIS = K_VALOR_ZERO)

If sinalRadicando = K_SINAL_NEGATIVO And IndicePar Then

Me.Valor = K_VALOR_INDEFINIDO

Else

Me.Valor = RadiciarNumero(radicando, Indice, diferenca)

Me.Sinal = sinalRadicando

Resto.Valor = diferenca

Resto.Sinal = sinalRadicando

End If

End If

Radiciar.Valor = Me.Valor

End Function

Private Function RadiciarNumero(ByVal radicando As String, ByVal Indice As Long, Optional ByRef Resto As String) As String

Dim tamanho As Long, radicandoParcial As String, radicandoTotal As String, raiz As Byte, potencia As String, _

comparacao As String, comparador As String, incremento As Long, potenciaAnterior As String

tamanho = Len(radicando) Mod Indice

If tamanho = K_VALOR_ZERO Then

tamanho = Indice

End If

RadiciarNumero = K_STRING_VAZIA

radicandoParcial = K_STRING_VAZIA

potencia = K_ALGARISMO_ZERO

Do While radicando <> K_STRING_VAZIA

radicandoParcial = radicandoParcial + Left(radicando, tamanho)

radicandoTotal = radicandoTotal + Left(radicando, tamanho)

radicando = Mid(radicando, tamanho + K_VALOR_UM)

radicandoParcial = RetirarZerosNaoSignificativos(radicandoParcial)

tamanho = Indice

If CompararNumeros(radicandoParcial, K_ALGARISMO_DOIS) = K_SINAL_MENOR Then

raiz = radicandoParcial

potencia = radicandoParcial

Else

raiz = K_VALOR_CINCO

Do

potenciaAnterior = potencia

potencia = PotenciarNumero(RadiciarNumero + CStr(raiz), Indice)

comparacao = CompararNumeros(potencia, radicandoTotal)

If raiz = K_VALOR_CINCO Then

If comparacao = K_SINAL_MENOR Then

comparador = K_SINAL_MENOR

incremento = K_VALOR_UM

ElseIf comparacao = K_SINAL_MAIOR Then

comparador = K_SINAL_MAIOR

incremento = -K_VALOR_UM

Else

Exit Do

End If

ElseIf comparacao <> comparador Then

If comparador = K_SINAL_MENOR Then

raiz = raiz - K_VALOR_UM

potencia = potenciaAnterior

End If

Exit Do

End If

raiz = raiz + incremento

Loop

End If

RadiciarNumero = RadiciarNumero + CStr(raiz)

radicandoParcial = SubtrairNumeros(radicandoParcial, potencia)

Loop

Resto = radicandoParcial

End Function

Public Function MaximoDivisorComum(ByRef Value As BigInteger) As BigInteger

Dim value1 As String, value2 As String, sinal1 As String, sinal2 As String, diferenca As String

value1 = Me.Valor

sinal1 = Me.Sinal

value2 = Value.Valor

sinal2 = Value.Sinal

If sinal1 = sinal2 Then

sinal1 = K_SINAL_POSITIVO

Else

sinal1 = K_SINAL_NEGATIVO

End If

If CompararNumeros(value1, value2) = K_SINAL_MAIOR Then

MaximoDivisorComum = sinal1 + CalcularMDC(value1, value2)

Else

MaximoDivisorComum = sinal2 + CalcularMDC(value2, value1)

End If

End Function

Private Function CalcularMDC(ByVal value1 As String, ByVal value2 As String) As String

Dim Resto As String

Do

DividirNumeros value1, value2, Resto

If CompararNumeros(Resto, K_ALGARISMO_ZERO) = K_SINAL_IGUAL Then

Exit Do

Else

value1 = value2

value2 = Resto

End If

Loop

CalcularMDC = value2

End Function

Public Function MinimoMultiploComum(Value As BigInteger) As BigInteger

Dim value1 As String, value2 As String, sinal1 As String, sinal2 As String, mdc As String

value1 = Me.Valor

sinal1 = Me.Sinal

value2 = Value.Valor

sinal2 = Value.Sinal

If CompararNumeros(value1, value2) = K_SINAL_MAIOR Then

mdc = CalcularMDC(value1, value2)

Else

mdc = CalcularMDC(value2, value1)

End If

value1 = DividirNumeros(value1, mdc, K_VALOR_ZERO)

If sinal1 = sinal2 Then

MinimoMultiploComum.Valor = K_SINAL_POSITIVO + MultiplicarNumeros(value1, value2)

Else

MinimoMultiploComum.Valor = K_SINAL_NEGATIVO + MultiplicarNumeros(value1, value2)

End If

End Function

Public Function Oposto(ByVal Value As String) As String

Dim Sinal As String

Sinal = Left(Value, K_VALOR_UM)

If Sinal = K_SINAL_POSITIVO Then

Oposto = K_SINAL_NEGATIVO + Mid(Value, K_VALOR_DOIS)

ElseIf Sinal = K_SINAL_NEGATIVO Then

Oposto = K_SINAL_POSITIVO + Mid(Value, K_VALOR_DOIS)

Else

Oposto = K_SINAL_NEGATIVO + Value

End If

End Function

Public Function Absoluto(ByVal Value As String) As String

Dim Sinal As String

Sinal = Left(Value, K_VALOR_UM)

If Sinal = K_SINAL_POSITIVO Then

Oposto = Value

ElseIf Sinal = K_SINAL_NEGATIVO Then

Oposto = K_SINAL_POSITIVO + Mid(Value, K_VALOR_DOIS)

Else

Oposto = K_SINAL_POSITIVO + Value

End If

End Function

Private Function RetirarZerosNaoSignificativos(ByVal Value As String) As String

Dim i As Long, Sinal As String

Do While Left(Value, K_VALOR_UM) = K_ALGARISMO_ZERO

Value = Mid(Value, K_VALOR_DOIS)

Loop

If Value = K_STRING_VAZIA Then

Value = K_ALGARISMO_ZERO

End If

RetirarZerosNaoSignificativos = Value

End Function

Private Function CompararNumeros(ByVal value1 As String, ByVal value2 As String) As String

Dim sinal1 As String, sinal2 As String

CompararNumeros = K_STRING_VAZIA

If Len(value1) > Len(value2) Then

value2 = String(Len(value1) - Len(value2), K_ALGARISMO_ZERO) + value2

Else

value1 = String(Len(value2) - Len(value1), K_ALGARISMO_ZERO) + value1

End If

If value1 > value2 Then

CompararNumeros = K_SINAL_MAIOR

ElseIf value1 < value2 Then

CompararNumeros = K_SINAL_MENOR

Else

CompararNumeros = K_SINAL_IGUAL

End If

End Function

Private Function FormatarNumero(Value As String) As String

Dim tamanho As Long, Sinal As String

FormatarNumero = K_STRING_VAZIA

Sinal = Left(Value, K_VALOR_UM)

If Sinal = K_SINAL_POSITIVO Or Sinal = K_SINAL_NEGATIVO Then

Value = Mid(Value, K_VALOR_DOIS)

Else

Sinal = K_STRING_VAZIA

End If

tamanho = Len(Value) Mod K_VALOR_TRES

If tamanho = K_VALOR_ZERO Then

tamanho = K_VALOR_TRES

End If

Do While Value <> K_STRING_VAZIA

If FormatarNumero <> K_STRING_VAZIA Then

FormatarNumero = FormatarNumero + Application.ThousandsSeparator

End If

FormatarNumero = FormatarNumero + Left(Value, tamanho)

Value = Mid(Value, tamanho + K_VALOR_UM)

tamanho = K_VALOR_TRES

Loop

FormatarNumero = Sinal + FormatarNumero

End Function

***********************************

E também um módulo de funções com o seguinte conteúdo:

Option Explicit

Public Const K_SINAL_POSITIVO As String * 1 = "+"

Public Const K_SINAL_NEGATIVO As String * 1 = "-"

Public Const K_SINAL_MENOR As String * 1 = "<"

Public Const K_SINAL_IGUAL As String * 1 = "="

Public Const K_SINAL_MAIOR As String * 1 = ">"

Public Const K_SINAL_DIVISAO As String * 1 = ":"

Public Const K_ALGARISMO_ZERO As String * 1 = "0"

Public Const K_ALGARISMO_UM As String * 1 = "1"

Public Const K_ALGARISMO_DOIS As String * 1 = "2"

Public Const K_ALGARISMO_CINCO As String * 1 = "5"

Public Const K_ALGARISMO_NOVE As String * 1 = "9"

Public Const K_ALGARISMO_DEZ As String * 2 = "10"

Public Const K_VALOR_ZERO As Byte = 0

Public Const K_VALOR_UM As Byte = 1

Public Const K_VALOR_DOIS As Byte = 2

Public Const K_VALOR_TRES As Byte = 3

Public Const K_VALOR_CINCO As Byte = 5

Public Const K_VALOR_NOVE As Byte = 9

Public Const K_VALOR_DEZ As Byte = 10

Public Const K_VALOR_INDEFINIDO As String = "N/D"

Public Const K_STRING_VAZIA As String = ""

Public Const K_TAMANHO_DECIMAIS As Long = 50

Option Explicit

Public Function FiltrarDigitos(ByVal Value As String, Optional Sinalizado As Boolean = True, Optional ByVal HeNumeroInteiro As Boolean = True) As String

Dim i As Long, char As String, Sinal As String, posicaoVirgula As Boolean

Sinal = K_SINAL_POSITIVO

FiltrarDigitos = K_STRING_VAZIA

posicaoVirgula = K_VALOR_ZERO

For i = K_ALGARISMO_UM To Len(Value)

char = Mid(Value, i, K_VALOR_UM)

If char = K_SINAL_NEGATIVO Then

If FiltrarDigitos = K_STRING_VAZIA Then

Sinal = char

End If

ElseIf char = K_ALGARISMO_ZERO Then

If FiltrarDigitos <> K_STRING_VAZIA Then

FiltrarDigitos = FiltrarDigitos + char

End If

ElseIf Not (char < K_ALGARISMO_ZERO Or char > K_ALGARISMO_NOVE) Then

FiltrarDigitos = FiltrarDigitos + char

ElseIf char = Application.DecimalSeparator And Not HeNumeroInteiro Then

If posicaoVirgula = K_VALOR_ZERO Then

If FiltrarDigitos = K_STRING_VAZIA Then

FiltrarDigitos = K_ALGARISMO_ZERO

End If

posicaoVirgula = Len(FiltrarDigitos)

End If

End If

Next

If FiltrarDigitos = K_STRING_VAZIA Then

FiltrarDigitos = K_ALGARISMO_ZERO

ElseIf posicaoVirgula > 0 Then

FiltrarDigitos = Left(FiltrarDigitos, posicaoVirgula) + _

Application.DecimalSeparator + _

Mid(FiltrarDigitos, posicaoVirgula + 1)

End If

If Sinalizado Then

FiltrarDigitos = Sinal + FiltrarDigitos

End If

End Function