Abreviar nomes Excel

Question

Tenho o seguinte código abaixo para abreviar nomes que encontrei em um fórum, porém preciso que ele abrevie nomes que não possuam preposição.

EX: Maria Jose Almeida Prado Braga Silva

Não consegui entender muito bem o código ai fiquei preso e não consigo achar solução.

Function AbreviarNomes(Nome As String, NumCaract As Long) As String
Dim LocSpc As Long
Dim SpcAnt As Long
Dim iLoc As Long
Dim NomeAtu As String
Dim Palavra As String

VerProx:
If Len(NomeAtu) > NumCaract Then
    LocSpc = 0
    SpcAnt = 0
    iLoc = Len(NomeAtu)
    While iLoc > 1
        If Mid(NomeAtu, iLoc, 1) = " " Then
            SpcAnt = LocSpc
            LocSpc = iLoc
            If SpcAnt > 0 Then
                Palavra = Mid(NomeAtu, LocSpc + 1, SpcAnt - LocSpc - 1)
                If Len(Palavra) > 1 Then
                    If (Palavra <> "DE") And (Palavra <> "DA") And (Palavra <> "DAS") And (Palavra <> "DO") And (Palavra <> "DOS") And (Palavra <> "DI") Then
                        Palavra = Left(Palavra, 1)
                        NomeAtu = Left(NomeAtu, LocSpc) & Palavra & Right(NomeAtu, Len(NomeAtu) - SpcAnt + 1)
                        GoTo VerProx
                    End If
                End If
            End If
        End If
        iLoc = iLoc - 1
    Wend
Else
    AbreviarNomes = NomeAtu
End If
End Function

Agradeço desde já,
Abraços.

---

Laionel Lellis

Answer 1

Esse código é arcaico, e por isso tens dificuldades em compreendê-lo.

Se o que queres é uma função para retirar as preposições dos nomes completos, por exemplo Maria do Carmo = Maria Carmo,  deixo-te uma função simples que podes até usar no excel:

Public Function AbreviarNomes(Nome As String) As String
    Dim X As Variant, I As Long, S As String
      
    'dividir o nome em palavras separadas por espaço
    X = Split(Nome, " ") ' SPLIT é a função que separa o texto num vetor de textos
    
    'percorrer a lista à procura das preposições
    For I = 0 To UBound(X) ' UBOUND é a função que nos diz qual o maior indice do vetor
        S = UCase(X(I)) ' UCASE transforma o texto em maiusculas.
        If S = Not ("DE" Or S = "DA" Or S = "DO" Or S = "DAS" Or S = "DOS") Then
            'quando não for uma preposição juntar ao nome final
            AbreviarNomes = AbreviarNomes & " " & X(I)
        End If
    Next I
    
End Function

Answer 2

Não é bem isso que necessito.

Vou explicar: Tenho uma variável que recebe o valor (string) de um inputbox, porem utilizo esse valor que no caso é um nome para nomear uma nova planilha, porém o excel só aceita nomes com até 31 caracteres. A intenção é abreviar os nomes se ultrapassarem esse limite porém o código que utilizei só abrevia se o nome contiver uma preposição. Também não posso retirar alguma parte do nome por haver várias pessoas com nomes parecidos.

Preciso que isto:

Maria Jose Almeida Prado Braga Silva

Fique assim:

Maria Jose A P Braga Silva

<object height="0" id="5a2aa859-191a-90a8-bb2b-6ba30abfab81" style=";left:0px;top:0px;" type="application/gas-events-bb" width="0"></object>

---

Laionel Lellis

Answer 3

Não tinha percebido o que querias, dado o exemplo de código que mostraste.

Basta acrescentar o que falta.

O ideal será começar a abreviar pelas palavras do meio até ser atingido o máximo de caracteres pretendido.

Segue a função em VBA completa:

Public Function AbreviarNomes(Nome As String, Optional MaxCaracteres As Long = 0) As String
    Dim X As Variant, I As Long, S As String
      
    'dividir o nome em palavras separadas por espaço
    X = Split(Nome, " ") ' SPLIT é a função que separa o texto num vetor de textos
    
    'percorrer a lista à procura das preposições
    For I = 0 To UBound(X) ' UBOUND é a função que nos diz qual o maior indice do vetor
        S = UCase(X(I)) ' UCASE transforma o texto em maiusculas.
        If Not (S = "DE" Or S = "DA" Or S = "DO" Or S = "DAS" Or S = "DOS") Then
            'quando não for uma preposição juntar ao nome final
            AbreviarNomes = AbreviarNomes & " " & X(I)
        End If
    Next I
    AbreviarNomes = Trim(AbreviarNomes) 'retirar o espaço inicial
    
    'quando o máximo for 0 não abreviar
    'ou quando não exceder o limite
    If Len(AbreviarNomes) <= MaxCaracteres Then Exit Function
    
    
    
    'caso seja necessário fazer redução
    Dim L As Long, C As Long, P As Long, P1 As Long, P2 As Long
    X = Split(AbreviarNomes, " ") 'separar novamente
    P = UBound(X): P1 = P \ 2: P2 = P1 + 1
    C = Len(AbreviarNomes) - MaxCaracteres 'Quantidade de caracteres para cortar
    
    'começar abreviando os nomes do meio
    'até chegar ao corte desejado
    Do Until C <= 0
        C = C + 1 - Len(X(P1))
        X(P1) = Left(X(P1), 1)
        If C <= 0 Then Exit Do
        
        C = C + 1 - Len(X(P2))
        X(P2) = Left(X(P2), 1)
        If C <= 0 Then Exit Do
        
        P1 = P1 - 1
        P2 = P2 + 1
        If P2 >= P Then Exit Do
    Loop
    
    'juntar tudo
    AbreviarNomes = X(0)
    For I = 1 To UBound(X)
        AbreviarNomes = AbreviarNomes & " " & X(I)
    Next I
    
End Function

Answer 4

Bom deixa eu complicar mais um pouco, quem sabe você consegue me ajudar.

Seria possível manter preferencialmente o Primeiro  Segundo nome e o ultimo.

Ex:   Carlos Alberto da Silva João Lasmar

Ficar Carlos Alberto S J Lasmar

Desde já muito grato pela atenção.

---

Laionel Lellis

Answer 5

É fácil.

Dá uma olhadela à instrução 'If P2 >= P Then Exit Do'

Ela faz uma das coisas que você pede, não abrevia o ultimo nome.

Para fazer a outra, não abreviar os dois primeiros nomes, basta juntar mais uma instrução, antes ou depois desta: 'If P1<2 Then Exit Do' para não abreviar os dois primeiros nomes.

Também estes requisitos podem ser colocados como parametros opcionais, logo a seguir ao Máximo. Aí ficaria uma função deveras versátil. É o meu modo preferido de programar.

Se você colocar esta função num modulo do Excel e usá-la numa das folhas (planilhas), pode testar vários nomes e tamanhos máximos diferentes.

Answer 6

To precisando estudar mais VBA mesmo, não consegui fazer funcionar, dependendo do tamanho do nome ele abrevia o segundo nome.

---

Laionel Lellis

Answer 7

Poderia me ajudar? gostaria de abreviar os nomes mas permanecer o ultimo. Exemplo Ana Maria da Silva ficar Ana M Silva.

Answer 8

Basta subtrair a ultima posição do array de nomes, sendo assim ele não irá passar pela função de abreviar:

For I = 0 To UBound(X)-1

A eu não cheguei a testar, qualquer coisa volte a informar.

---

Laionel Lellis

Answer 9

Condições

1. Abreviar apenas os nomes que ultrapassam de 31 letras contando com os espaços.
2. Manter o primeiro, segundo e último nome.

Após excluir as preposições e as letras do nome forem menor que 31 não há necessidade de abreviar.

O código ira funcionar apenas quando o nome tiver mais de 31 letras contando com os espaços.

Public Function AbreviaNome(byVal Nome as String)as String
Nome = "Carlos Alberto da Silva João Lasmar"
preposicao = Array("de", "da", "das", "do", "dos", "di")

If Len(Nome) < 31 Then Exit Sub

Nome = Split(Nome, " ")

''''retira preposicao''''
For y = 1 To UBound(Nome)
    For Each yy In preposicao
        If UCase(Nome(y)) = UCase(yy) Then
            Nome(y) = "|||||"
        End If
    Next
Next

Nome = Filter(Nome, "|||||", False)

''''abrevia nome'''''
If Len(Join(Nome, " ")) > 31 Then
    If Application.CountA(Nome) > 4 Then
        For I = 2 To UBound(Nome) - 1
            Nome(I) = UCase(Left(Nome(I), 1)) & "."
        Next
    End If
End If

Nome = Join(Nome, " ")

End Sub