Abreviar nomes no meio da célula

Planilhas, Arquivos, modelos, exemplos, apostilas, nosso datacenter!

Abreviar nomes no meio da célula

Mensagempor Rafaellinopa » Sex Jul 10, 2009 5:55 pm

Surgiu como dúvida de membro da comunidade de saber como se abreviava nomes do meio numa célula.

Código: Selecionar todos
Function ABREVIARNOMES(Célula As Range, ParamArray NomesSemAbreviar()) As String
Dim PrimeiroNome As String, Texto As String, _
ÚltimoNome As String, Abrev As String
Dim i As Integer, k As Integer, Opcional As Integer, Controle As Integer
Dim Nome, Nomes, NomeSemAbreviar, PosiçãoInicial

Application.Volatile


'Se só houver uma palavra, somente ela é retornada
Texto = Célula
If InStr(1, Texto, " ") = 0 Then
ABREVIARNOMES = Texto
Exit Function
End If

'Retornar todas a palavras do nome para uma matriz
Nomes = Split(Texto, " ")

'Retornar o primeiro nome
PrimeiroNome = Left(Texto, InStr(1, Texto, " ") - 1)

'Retornar o último nome
ÚltimoNome = Right(Texto, Len(Texto) - InStrRev(Texto, " ", -1))

'Se não for informado o argumento opcional, é atribuída uma cadeia vazia
If IsMissing(NomesSemAbreviar) Then
Opcional = 1
End If
'Loop para percorrer os nomes do texto informado
For Each Nome In Nomes
Select Case Len(Nome)
'Não abreviar conectores como "e"
Case 1
Abrev = Abrev & Nome & Space(1)
'Não abreviar conectores como "de" ou "das"
Case 2, 3
If Left(Nome, 1) = "d" Then Abrev = Abrev & Nome & Space(1)
Case Else
'Execução para o caso em que não há argumentos opcionais
If Opcional = 1 Then
Abrev = Abrev & UCase(Left(Nome, 1)) & "." & Space(1)
Else
'Quando há argumentos opcionais testa o nome contra cada um deles
For Each NomeSemAbreviar In NomesSemAbreviar
If Nome = NomeSemAbreviar Then
Controle = 1
Exit For
Else
Controle = 0
End If
Next NomeSemAbreviar

If Controle = 1 Then
'Se for encontrada coincidência com os argumentos opcionais, não realiza abreviatura
Abrev = Abrev & Nome & Space(1)
Else
'Se não for encontrada coincidência com os argumentos opcionais, realiza abreviatura
Abrev = Abrev & UCase(Left(Nome, 1)) & "." & Space(1)
End If
End If
End Select
Next Nome

'Criar o nome final definitivo, com abreviaturas e demais considerações
Abrev = PrimeiroNome & Right(Abrev, Len(Abrev) - InStr(1, Abrev, "."))
ABREVIARNOMES = Left(Abrev, Len(Abrev) - 3) & ÚltimoNome

End Function


Depois na planilha basta usar:

=ABREVIARNOMES(Célula) --> que os nomes do meio serão abreviados

Ou:
=ABREVIARNOMES("José de Anchieta dos Santos Neves";"Anchieta"): "José de Anchieta dos S. Neves", ou seja, o "Anchieta" não é abreviado. O segundo argumento é opcional e podem ser colocados vários nomes, separados por ponto e vírgula.

Excelente Código de autoria de Adilson Soledade moderador de nossa comunidade. :geek:
Att,

Rafael Lino
http://www.planilhando.com.br - Seu forum de Excel
+55 79 9199 4075 - MSN: rafaellinopa@hotmail.com
Avatar do usuário
Rafaellinopa
Membro
Membro
 
Mensagens: 263
Registrado em: Sex Jul 03, 2009 11:07 pm
Has thanked: 5 times
Have thanks: 22 times

{ SO_SELECT }

Abreviação de nomes por quantidade de caracteres.

Mensagempor isaac83br » Seg Ago 15, 2016 5:18 pm

Oi Amigos,

Gostei muito do codigo VBA desenvolvedo por nosso amigo, bem completo pra mim que estou introduzindo funções em VBA no Execel,
mas como que cada formula atende suas necessidades particulares, precisava de uma semelhante que pudesse definir abreviação pela quantidade de caracteres,
receber um valor dos caracteres da quantidade maior de tantos reduzir nas abreviações.
será que é muito complicado?
isaac83br
Membro
Membro
 
Mensagens: 3
Registrado em: Sex Ago 12, 2016 9:43 am
Has thanked: 0 time
Have thanks: 0 time

Re: Abreviar nomes no meio da célula

Mensagempor isaac83br » Seg Ago 15, 2016 5:28 pm

Exemplo:
A1: ANTONIO JOSE ANDRADE MARTINS DOS SANTOS
B2: ANTONIO JOSE A. M. DOS SANTOS

A1: 39 caracteres
B2: 29 Caracteres

Dependendo da quantidade de caracteres ele reduziria do terceiro nome até o penúltimo sobrenome.

Amigos, não sei se consegui explicar.
isaac83br
Membro
Membro
 
Mensagens: 3
Registrado em: Sex Ago 12, 2016 9:43 am
Has thanked: 0 time
Have thanks: 0 time

Re: Abreviar nomes no meio da célula

Mensagempor Reinaldo » Seg Ago 15, 2016 10:18 pm

Se não informar qual(is) nomes abreviar não chegara no que deseja
Reinaldo
Gostou da resposta? Clique no ícone "Positivo" da mensagem!(ao lado de citar)
Avatar do usuário
Reinaldo
Expert
Expert
 
Mensagens: 3979
Registrado em: Sáb Dez 19, 2009 9:59 am
Localização: Garça - SP / SCS - SP
Has thanked: 168 times
Have thanks: 1793 times

Re: Abreviar nomes no meio da célula

Mensagempor isaac83br » Ter Ago 16, 2016 12:17 pm

o Critério é o primeiro e segundo nome sem abreviações, não importa a quantidade de nomes que a pessoa possa ter, mas que continue apenas o primeiro, segundo e ultimo nome.
o restante entre esse meio pode abreviar com exerção: "e" "das" "dos" "de" "do" "da" (quando for apenas 1, 2 e 3 caracteres)

Não sei se conseguir informar bem.
isaac83br
Membro
Membro
 
Mensagens: 3
Registrado em: Sex Ago 12, 2016 9:43 am
Has thanked: 0 time
Have thanks: 0 time

Re: Abreviar nomes no meio da célula

Mensagempor Matheusdsr » Ter Dez 05, 2017 1:52 pm

Oi, Caros.

Gostaria de Saber se teria como o código VBA fornecer as abreviações mas sem os pontos (José A S Neves). Desde já agradeço pela ajuda.
Matheusdsr
Membro
Membro
 
Mensagens: 1
Registrado em: Ter Dez 05, 2017 1:47 pm
Has thanked: 0 time
Have thanks: 0 time


Voltar para Biblioteca

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 1 visitante