Escrever Número Por Extenso

Olá queridos leitores.
Hoje disponibilizo a vocês uma formulazinha muito importante no nosso cotidiano. E aproveito para refletir um pouco. Por que será que o Excel já não disponibiliza nativamente uma função para executar a leitura de um número por extenso? Caramba! Que fórmula chatinha de desenvolver! Visto do ponto que o resultado é algo tão simples. Para vocês terem uma idéia, para que o excel escreva cem reais, por exemplo, ele tem que verificar se existem casas decimais, quantos algarismos possui o número, a que grupo de milhar ou centena pertence, se a unidade é decimal ou não, se o valor é maior ou igual a cem, porque se for 100, escreve-se “cem”, se for 101 ou mais, escreve-se “cento”. Haja paciência. Isto sem contar nos conectores do tipo “e”, “reais” ou “centavos”. Diferenciando-se, valores unitários dos demais, para definir se o termo virá no singular ou no plurar.
Apesar de tudo isso, essa fórmula é essencial ao nosso uso. Muitas aplicações ficam mais apresentáveis e profissionais com sua aplicação. Uma planilha de recibo por exemplo. Onde se exibe o valor pago, fica bem mais perfeito e atraente se estiver esse valor descrito de forma textual também. até mesmo se o intuito for imprimir. Bem mais aceitável.

Mas como não estou aqui para reclamar, tenho uma sugestão: Vamos começar logo porque senão vamos perder o jantar…
 

Iniciando o projeto

 
No excel vamos criar uma função personalizada que irá fazer os cálculos e análises num módulo do projeto VBA e será acessada diretamente na célula onde deseja exibir o resultado. Falei um pouco sobre a diferença entre function e sub no artigo sobre Contar Células Coloridas.
Chame a fórmula assim:
=ConverterParaExtenso(A2)
Onde A2 é onde se encontra o valor a descrever por extenso.
EscreveExtenso_p
Não vou me deter muito em exlicações detalhadas, visto que, a maioria do processo é de fácil conhecimento e entendimento. É apenas um procedimento de muito cálculo e análise. Portanto, preste bastante atenção.
 

O Código

 
O código abaixo deve ser escrito num Módulo. Farei alguns comentários em seguida.
 

Public Function ConverterParaExtenso(NumeroParaConverter As String) As String
Dim sExtensoFinal As String, sExtensoAtual As String
Dim i As Integer
Dim iQtdGrupos As Integer
Dim sDecimais As String
Dim sMoedaSing As String, sMoedaPlu As String, sCentavos As String
Dim bSufMoeda As Boolean
'Separa os Decimais
If InStr(1, NumeroParaConverter, ",") > 0 Then
sDecimais = Right(NumeroParaConverter, Len(NumeroParaConverter) - InStr(1, NumeroParaConverter, ","))
NumeroParaConverter = Mid(NumeroParaConverter, 1, InStr(1, NumeroParaConverter, ",") - 1)
End If
'Obtém a separação de milhares
iQtdGrupos = Fix(Len(NumeroParaConverter) / 3)
If Len(NumeroParaConverter) Mod 3 > 0 Then
iQtdGrupos = iQtdGrupos + 1
End If
'Chama as funções para escrever o número
If iQtdGrupos > 2 Then bSufMoeda = True
For i = iQtdGrupos To 1 Step -1
sExtensoAtual = DesmembraValor(NumeroParaConverter, i)
If i = 1 Then
If sExtensoAtual = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
If sExtensoFinal = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
sExtensoFinal = sExtensoFinal & " e " & sExtensoAtual
End If
End If
Else
sExtensoFinal = sExtensoFinal & sExtensoAtual
End If
If iQtdGrupos > 2 Then
Select Case i
Case 1, 2
If sExtensoAtual <> "" Then
bSufMoeda = False
End If
End Select
End If
Next i
'Define a moeda
sMoedaPlu = " reais"
sMoedaSing = " real"
If bSufMoeda = True Then sMoedaPlu = " de reais"
'Escreve os Centavos
sCentavos = EscreveCentavos(sDecimais)
'Adiciona a moeda e os centavos
sExtensoFinal = IIf((sExtensoFinal = ""), "", sExtensoFinal & IIf((sExtensoFinal = "um"), sMoedaSing, sMoedaPlu)) _
& IIf((sExtensoFinal = ""), sCentavos, IIf((sCentavos = ""), "", " e " & sCentavos))
'retorna o resultado
ConverterParaExtenso = sExtensoFinal
End Function
Private Function DesmembraValor(sValor As String, iGrupoDiv As Integer) As String
Dim iValor As Integer
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim iPosInicMid As Integer
Dim iTamMid As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim vArrCentena As Variant
vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")
vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")
vArrCentena = Array("cem", "cento", "duzentos", "trezentos", "quatrocentos", _
"quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")
'Pega o Valor a ser escrito e desmembra para o grupo numérico correto
iPosInicMid = Len(sValor) - ((3 * iGrupoDiv) - 1)
If iPosInicMid <= 1 Then
iTamMid = 2 + iPosInicMid
Else
iTamMid = 3
End If
If iPosInicMid < 1 Then iPosInicMid = 1
iValor = CInt(Mid(sValor, iPosInicMid, iTamMid))
Select Case iGrupoDiv
Case 2
sComplemento = " mil "
Case 3
If iValor = 1 Then
sComplemento = " milhão "
Else
sComplemento = " milhões "
End If
Case 4
If iValor = 1 Then
sComplemento = " bilhão "
Else
sComplemento = " bilhões "
End If
Case 5
If iValor = 1 Then
sComplemento = " trilhão "
Else
sComplemento = " trilhões "
End If
End Select
Select Case iValor
Case 0 To 19
sExtenso = vArrDez1(iValor)
Case 20 To 99
iDivInteiro = Fix(iValor / 10)
iDivResto = iValor Mod 10
If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
Case 100 To 999
iDivInteiro = Fix(iValor / 100)
iDivResto = iValor Mod 100
If iDivResto = 0 Then
If iDivInteiro = 1 Then
sExtenso = vArrCentena(0)   'Cem
Else
sExtenso = vArrCentena(iDivInteiro) 'inteiro maior que 100
End If
Else
sExtenso = vArrCentena(iDivInteiro) & " e "
Select Case iDivResto
Case 0 To 19
sExtenso = sExtenso & vArrDez1(iDivResto)
Case 20 To 99
iDivInteiro2 = Fix(iDivResto / 10)
iDivResto2 = iDivResto Mod 10
If iDivResto2 = 0 Then
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2)
Else
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2) & " e " & vArrDez1(iDivResto2)
End If
End Select
End If
End Select
DesmembraValor = sExtenso & IIf(iValor > 0, sComplemento, "")
End Function
Private Function EscreveCentavos(sCent As String) As String
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim iCent As Integer
vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")
vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")
'Adequando para duas casas decimais
iCent = Fix(sCent & String(2 - Len(sCent), "0"))
'Escrevendo Singular ou plural
If iCent = 1 Then
sComplemento = " centavo"
Else
sComplemento = " centavos"
End If
'Calculando os valores
Select Case iCent
Case 0 To 19
sExtenso = vArrDez1(iCent)
Case 20 To 99
iDivInteiro = Fix(iCent / 10)
iDivResto = iCent Mod 10
If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
End Select
EscreveCentavos = IIf(iCent > 0, sExtenso & sComplemento, "")
End Function

 

Explicando a Macro VBA.

 
 
Existem três funções no código:

  • Public Function ConverterParaExtenso(NumeroParaConverter As String) As String
  • Private Function DesmembraValor(sValor As String, iGrupoDiv As Integer) As String
  • Private Function EscreveCentavos(sCent As String) As String

 
Vamos começar pela mais simples, EscreveCentavos. Esta função é privada, portanto é disponível apenas ao acesso interno. Ela verifica a presença de decimais e escreve seu conteúdo.
Nas linhas 178 a 183 foram declaradas duas matrizes que contém os valores textuais para os números de 1 a 19 e de 20 a 90, em múltiplos de 10, respectivamente.
Nas linhas 189 a 193, efetua-se uma verificação para saber se o valor textual para o termo “centavos” deve estar no singular, no caso de apenas 1 centavo, ou no plural, para os demais valores.
Nas linhas de 196 a 208 são feitos todos os cálculos e atribuições de valores. Descobrindo-se o valor em número e substituindo-o pelo seu correspondente textual armazenado nas matrizes definidas no início.
Por fim, na linha 210 é exibido o resultado obtido, atentando-se ao fato de que se não houver valor nenhum, ou seja, 0 centavos, será retornado vazio.
Na função DesmembraValor, segue-se o mesmo raciocínio, apenas com algumas adições como, por exemplo, nas linhas de 90 a 100, a verificação à qual grupo de milhar ou centena pertence o número analizado.
Nas linhas de 102 a 123, define-se os termos identificadores do grupo. Milhões, bilhões, trilhões. E analisando, é claro, se estão no singular ou no plural. De 125 a 164 é feito todo o cálculo para definir as expressões textuais dos números baseando-se nas matrizes definidas anteriormente.
Enfim, a função que será acessada pelo Excel, ConverterParaExtenso. Nas linhas de 24 a 48 é realizado um loop para executar a função que excreve o valor por extenso de cada grupo numérico separadamente. A função para tal é chamada na linha 25. Em seguida, ainda dentro do loop são feitas verificações para definir conectores do tipo “e” e “moeda”.
Na linha 57 executamos a leitura dos centavos. Nas linhas 60 e 61, juntamos tudo. E, por fim, na linha 64, enviamos o resultado para a função retornar à célula que a chamou.
 
Não é complicado, apenas extenso. Disponibilizei o arquivo com esta macro prontinha para download no fim deste artigo, ok.
Amigos, obrigado pelo seu prestígio. Aguardo vocês sempre. Assine grátis nossa newsletter e também.
Um abraço.
 

Veja os Termos aprendidos neste artigo:

 

InStr Retorna uma Variant (Long) que especifica a posição da primeira ocorrência de uma seqüência de caracteres dentro de outra.SintaxeInStr([start, ]string1, string2[, compare])
A sintaxe da função InStr tem os seguintes argumentos:

Parte Descrição
start Opcional. Expressão numérica que define a posição inicial de cada pesquisa. Se omitido, a pesquisa iniciará na posição do primeiro caractere. Se start contiver Null, ocorrerá um erro. O argumento start será necessário, se compare for especificado.
string1 Obrigatória. Expressão de seqüência sendo pesquisada.
string2 Obrigatória. Expressão de seqüência de caracteres procurada.
compare Opcional. Especifica o tipo de comparação de seqüência de caracteres. Se compare for Null, ocorrerá um erro. Se compare for omitido, a configuração Option Compare determinará o tipo de comparação. Especifique um LCID (LocaleID) válido para usar regras específicas da localidade na comparação.

Definições
As configurações do argumento compare são as seguintes:

Constante Valor Descrição
vbUseCompareOption -1 Executa uma comparação usando a configuração da instrução Option Compare.
vbBinaryCompare 0 Executa uma comparação binária.
vbTextCompare 1 Executa uma comparação textual.
vbDatabaseCompare 2 Somente Microsoft Access. Efetua uma comparação, com base nas informações existentes no banco de dados.

Valores retornados

Se A InStr retornará
string1 tiver comprimento zero 0
string1 for Null Null
string2 tiver comprimento zero start
string2 for Null Null
string2 não for encontrado 0
string2 for encontrado dentro de string1 A posição em que a correspondência foi encontrada
start > string2 0
Len Retorna um Long que contém o número de caracteres existentes em uma seqüência de caracteres ou o número de bytes necessários para armazenar uma variável.SintaxeLen(string | varname)
A sintaxe da função Len tem as seguintes partes:

Parte Descrição
String Qualquer expressão de seqüência válida. Se string contiver Null, será retornado Null.
Varname Qualquer nome de variável válido. Se varname contiver Null, será retornado Null. Se varname for uma Variant, Len tratará essa variante como uma String e retornará sempre o número de caracteres nela contidos.
Mid Retorna uma Variant (String) que contém um número especificado de caracteres de uma seqüência de caracteres.SintaxeMid(string, start[, length])
A sintaxe da função Mid tem os seguintes argumentos nomeados:

Parte Descrição
string Obrigatória. Expressão de seqüência da qual são retornados os caracteres. Se string contiver Null, será retornado Null.
start Obrigatória; Long. A posição do caractere em string onde a parte a ser considerada começa. Se start for maior que o número de caracteres existentes em string, a função Mid retornará uma seqüência de caracteres de comprimento zero (“”).
length Opcional; Variant (Long). Número de caracteres a ser retornado. Se omitido ou se existirem menos caracteres do que os de length no texto (inclusive o caractere em start), serão retornados todos os caracteres a partir da posição start até o final da seqüência de caracteres.

Comentários
Para determinar o número de caracteres em string, use a função Len.

Right Retorna uma Variant (String) que contém um número especificado de caracteres, a partir do lado direito de uma seqüência de caracteres.SintaxeRight(string, length)
A sintaxe da função Right tem os seguintes argumentos nomeados:

Parte Descrição
string Obrigatória. Expressão de seqüência da qual serão retornados os caracteres da extrema direita. Se string contiver Null, será retornado Null.
length Obrigatória; Variant (Long). Expressão numérica que indica a quantidade de caracteres a ser retornada. Se for 0, será retornada uma seqüência de caracteres de comprimento zero (“”). Quando for maior ou igual ao número de caracteres em string, será retornada a seqüência de caracteres inteira.
Array Retorna um Variant contendo uma matriz.SintaxeArray(arglist)
O argumento obrigatório arglist é uma lista de valores delimitados por vírgulas que são atribuídos aos elementos da matriz contidos dentro de Variant. Se nenhum argumento for especificado, uma matriz de tamanho zero será criada.
Comentários
A notação usada para referir-se a um elemento de uma matriz consiste no nome de uma variável seguido por um número de índice entre parênteses indicando o elemento desejado. No exemplo a seguir, a primeira instrução cria uma variável denominada A como um Variant. A segunda instrução atribui uma matriz à variável A. A última instrução atribui o valor contido no segundo elemento de matriz a outra variável.

Dim A As Variant
A = Array(10,20,30)
B = A(2)

36 comentários em “Escrever Número Por Extenso”

  1. 1 2 3 4 5 . 0 1 2 3 4 5 6 7 8 9
    5 8 6 5 1 1 2 1 1
    3 4 0 6 8 1 1 1 1 1
    7 5 1 4 5 1 1 2 1
    0 7 8 1 3 qual a formula
    3 3 3 4 3 para contar desta forma
    0 5 3 4 2 para que fique assim
    1 0 1 7 0 como no grafico
    1 1 5 6 3

    Responder
  2. Aonde esta
    Coluna a,b,c,d,e tenho 5 colunas subseqüentes
    Só que dentro de cada coluna os números variam de maneira desordenada
    A b c d E . f g h i j k l m n O
    5 8 6 5 1 1 2 1 1
    3 4 0 6 8 1 1 1 1 1
    7 5 1 4 5 1 1 2 1
    0 7 8 1 3 Qual a formula
    3 3 3 4 3 Para contar desta forma
    0 5 3 4 2 Para que fique assim
    1 0 1 7 0 Como no gráfico
    1 1 5 6 3
    Ai tem uma referencia que
    A coluna f =0
    A coluna g =1
    A coluna h =1
    Só que dentro desta coluna a1 você vê que o 5 repetiu 2 vezes
    Variando ate 0,1,2,3,4,5,6,7,8,9, qual a formula para que eu conte
    Entre as
    Se você colar no Excel terá a noção

    Responder
    • Cara… agora entendi o que você quer.
      Muito simples.
      Supondo que seu intervalo de números desordenados seja das colunas A até E, coloque a seguinte fórmula para calcular de acordo com os algarismos desejados:
      Na coluna para mostrar os totais para o algarismo 0:
      =CONT.SE($A1:$E1;0)
      Na coluna para mostrar os totais para o algarismo 1:
      =CONT.SE($A1:$E1;1)
      Na coluna para mostrar os totais para o algarismo 2:
      =CONT.SE($A1:$E1;2)
      Na coluna para mostrar os totais para o algarismo 3:
      =CONT.SE($A1:$E1;3)
      E assim por diante até o algarismo 9, sempre substituindo o número em negrito pelo número que deseja contar.
      Depois copie a fórmula para as linhas seguintes.
      Espero que tenha ajudado.
      Abçs

      Responder
  3. Como se estreve 3.798,60 e tambem esses aqui > 972,20 E >1.462,00…
    Obrigada 😀
    Se for posivel para vcs por favor me mandem a resposta ainda hoje 🙂
    Eu fiaria bastante feliz se isso acontecese 😉
    Obrigada pela atenção de vcs e tenham uma boa noite de sono … 😀
    By:Nathália gabriela martins de lima 😉

    Responder
  4. Olá, parabéns pelo site, BEM interessante!
    Será que você poderia me ajudar com um projeto meu? Quero fazer uma planilha no excel que seja como um módulo de geração de orçamentos, e gostaria que o excel gerasse um número cada vez que eu abrisse a planilha(sem ser número aleatório, deve ser crescente, tipo, orçamento 1,2,3…) existe alguma fórmula que faça isso?
    Atte,
    Perin

    Responder
    • Luis, não existe fórmula pronta para isso, mas você pode fazer o seguinte. Armazenar o último número de orçamento gerado em uma célula especifica, de preferência numa planilha específica também e fazer referência a esta célula no momento da geração do novo orçamento. Sempre que a macro buscar este número, ele será incrementado em uma unidade para ser usado na próxima geração de novo orçamento.

      Responder
    • Manoel,
      Caso o padrão de seu código seja constante como no exemplo que você me pergunta, ou seja, 13 dígitos, separados por ponto (.) , um a um, exceto os dois últimos, você pode formatar a célula de maneira personalizada assim:
      Selecione as células desejadas;
      Tecle CTRL+1, para acessar a tela Formatar;
      Na aba Número, selecione a categoria Personalizado;
      E digite no campo Tipo: 0\.0\.0\.0\.0\.0\.0\.0\.0\.0\.0\.00
      Espero ter ajudado.
      Abraço

      Responder
  5. Olá amigo,
    Boa tarde!
    Achei muito interessante a sua página, e através do seu conhecimento gostaria de lhe pedir uma ajuda.
    Tem como dismembrar um numero de uma célula, por exemplo;
    O numero 306604 na celula B3, e utilizando alguma fórmula para desmembrá-lo nas demais celulas (C3=3,D3=0,E3=6,F3=6,G3=0,H3=4)?
    Muito obrigado pela atenção.

    Responder
  6. Olá amigo, boa tarde!!
    Preciso saber como faço para somar determinados valores que corresponde a um intervalo de datas como segue abaixo:
    quando eu selicionar o em duas listas suspensas o mês que quero ele busca o valor inicial 01/01/2010 a 28/02/2010.
    logo em seguida quero fazer uma consulta dos valores que estão compreendidos em 01/01/2010 a 31/03/2010 ou tb posso escolher os movimento de 01/02/2010 a 30/04/2010?
    Poderia me ajudar com esta dúvida.
    Grato
    Garrido

    Responder
  7. Boa noite Reinaldo
    Sou professora e queria usar esta fórmula para ajudar alguns alunos com a escrita de números, mas são crianças que estão em fase de alafabetização por isso eu precisaria que os números fossem escritos/convertidos em caixa alta. Você pode me dizer o que posso mudar no código pra conseguir isto?
    Obrigada
    Regiane

    Responder
  8. Bom dia!
    Cara, fico muito satisfeito com toda essa bagagem compartilhada por você aqui nessa área. Tenho sido muito ajudado com as dicas preciosíssimas disponíveis aqui.

    Responder
  9. Caro reinaldo,
    Valeu, há muito tempo eu buscava esta opção para escrever por extenso.
    Obrigado, genial.
    Aproveitando, face aos teus conhecimentos fantásticos, peço uma informação:
    Como fazer para que apenas algumas células (em uma planilha), mostrem seu conteúdo e não o seu resultado? É possível este comando apenas para algumas células e não toda a planilha?
    Exemplo:
    uma célula contém: =23+3,4
    o resultado normal que aparece é 26,4
    no entanto, eu gostaria de poder formatar apenas esta célula de forma que ao olhar a planilha pudesse ver =23+3,4 e as demais células com seus resultados normais.
    Obrigado,
    Ivar Bastos

    Responder
  10. Boa tarde,
    segui os passos referidos acima mas não está funcionando.
    Dá a mensagem: #NOME?
    Eu estou a utilizar o Office2010 e Win7 64
    Como percebo pouco de programação,
    Como poderei resolver?
    Obrigado
    Att

    Responder
  11. Olá!
    Teu post é muito completo, parabéns!
    Eu migrei para o excel 2010 student e os centavos estão de forma diferente do anterior.
    Por exemplo:
    Antes: 0,40 => quarenta centavos
    Agora: 0,40 => quatro décimos
    No entanto o excel student não tem a aba “desenvolvedores”.
    É possível me orientar a respeito?
    Desde já agradeço.

    Responder
  12. Com relação ao valor por extenso, quero utilizar para REAIS, DOLAR E EURO.
    Essa informação constará em uma célula (Tipo de moeda), tens que como a fórmula escrever por extenso a moeda correspondente.

    Responder
  13. Boa tarde!
    Antes de qualquer coisa, quero parabenizar pelo excelente tutorial.
    Com relação à ele, preciso deixar o texto entre parênteses. Há como fazê-lo?
    Abs

    Responder
    • Sim.
      Eu ensinei chamar a função desta maneira, não é mesmo?!
      =ConverterParaExtenso(A2)
      Então… Basta Concatenar os parênteses ao chamá-la. Assim:
      =CONCATENAR ( “(” ; ConverterParaExtenso(A2) ; “)” )
      Ou, simplesmente:
      =”(” & ConverterParaExtenso(A2) & “)”
      Abç

      Responder
  14. Desculpe se estou revivendo o tópico, mas estou usando este macro, porém não estou conseguindo uma coisa.
    Quero que somente a primeira letra fique em caixa alta, o resto em caixa baixa, dessa forma:
    1.903,45 – Mil, novecentos e três reais e quarenta e cinco centavos
    Dá pra deixar assim? Caso afirmativo, como?

    Responder
    • Olá Maurício, tudo bem?
      Uma maneira de obter este resultado, pode ser assim:
      Altere a linha 64 de:

      ConverterParaExtenso = sExtensoFinal

      Para:

      ConverterParaExtenso = UCase(Left(sExtensoFinal, 1)) & LCase(Right(sExtensoFinal, Len(sExtensoFinal) - 1))

      Espero que ajude.
      Um abraço.

      Responder

Deixe um comentário