none
Abreviar nomes Excel RRS feed

  • Pergunta

  • 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

    terça-feira, 18 de junho de 2013 14:53

Respostas

  • 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
    

    quarta-feira, 19 de junho de 2013 20:21

Todas as Respostas

  • 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
    

    terça-feira, 18 de junho de 2013 22:02
  • 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

    terça-feira, 18 de junho de 2013 22:53
  • 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
    

    quarta-feira, 19 de junho de 2013 20:21
  • 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

    sexta-feira, 21 de junho de 2013 14:44
  • É 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.

    sábado, 22 de junho de 2013 18:04
  • To precisando estudar mais VBA mesmo, não consegui fazer funcionar, dependendo do tamanho do nome ele abrevia o segundo nome.

    Laionel Lellis

    quinta-feira, 1 de agosto de 2013 11:49
  • Poderia me ajudar? gostaria de abreviar os nomes mas permanecer o ultimo. Exemplo Ana Maria da Silva ficar Ana M Silva.
    segunda-feira, 5 de março de 2018 09:20
  • 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


    terça-feira, 6 de março de 2018 14:21
  • 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
    





    • Sugerido como Resposta Renato MDSP sábado, 10 de março de 2018 00:44
    • Editado Renato MDSP terça-feira, 13 de março de 2018 11:56
    quinta-feira, 8 de março de 2018 21:33