Excel VBA - Retirar acentos de palavras nas células

Excel VBA - Retirar acentos de palavras nas células


A função abaixo é a mais completa e competente em retirar caracteres indesejáveis pelo seu amplo escopo de caracteres listados nela, e isso é percebido quando pesquisamos o assunto em toda a internet. Atualmente, Jul24, aqui está o único lugar onde o código com a correção mais ampla está disponível.


VBA - Função ConvertUTF8 - Converte os Dados Contidos na Célula no Padrão UTF8


Além dessa ser a função mais abrangente, desenvolvemos versões em diferentes níveis para facilitar a compreensão da implementação.


Divirta-se!


CÓDIGO ORIGINAL


Function ConvertAccent (ByVal inputString As String) As String

    ' Aplicação: Dados base do Power BI.

    ' Ação: Função que retira acentos

    ' Autor: André Bernardes

    ' Contato: andreluizbernardess@gmail.com

    ' Data: 10.07.23 - 15:15:52


    ' Constantes que contêm os caracteres acentuados e seus correspondentes sem acentos

    Const AccChars As String = _

"²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"


    Const RegChars As String = _

"2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"


    Dim i As Long, j As Long

    Dim tempString As String

    Dim currentCharacter As String

    Dim found As Boolean

    Dim foundPosition As Long


    ' Inicializa a string temporária com o valor da string de entrada

    Let tempString = inputString


    ' Determina qual string é mais curta para otimizar o loop

    Select Case True

        Case Len(AccChars) <= Len(inputString)

            ' A lista de caracteres acentuados é menor ou igual à string de entrada

            ' Loop pela lista de caracteres acentuados

            For i = 1 To Len(AccChars)

                ' Obtém o próximo caractere acentuado

                Let currentCharacter = Mid$(AccChars, i, 1)

                ' Substitui pelo caractere correspondente na lista de caracteres regulares

                If InStr(tempString, currentCharacter) > 0 Then

                    Let tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))

                End If

            Next i

        

        Case Len(AccChars) > Len(inputString)

            ' A string de entrada é menor

            ' Loop pela string de entrada

            For i = 1 To Len(inputString)

                ' Obtém o caractere atual da string de entrada e

                ' verifica se é um caractere especial

                Let currentCharacter = Mid$(inputString, i, 1)

                Let found = (InStr(AccChars, currentCharacter) > 0)


                If found Then

                    ' Encontra a posição do caractere especial na lista de caracteres acentuados

                    Let foundPosition = InStr(AccChars, currentCharacter)

                    ' Substitui pelo caractere correspondente na lista de caracteres regulares

                    Let tempString = Replace(tempString, currentCharacter, Mid$(RegChars, foundPosition, 1))

                End If

            Next i

    End Select


    ' Retorna a string convertida

    Let ConvertAccent = tempString

End Function

 Série de Livros nut Project 

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication) eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes

eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Access — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Excel — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Outlook — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Word — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes 


CÓDIGO COM MELHORIAS

As melhorias incluem a remoção de variáveis desnecessárias e a simplificação da lógica de substituição.


Function ConvertAccent (ByVal inputString As String) As String

    ' Aplicação: Dados base do Power BI.

    ' Ação: Função que retira acentos

    ' Autor: André Bernardes

    ' Contato: andreluizbernardess@gmail.com

    ' Data: 10.07.23 - 15:15:52


    ' Constantes que contêm os caracteres acentuados e seus correspondentes sem acentos

    Const AccChars As String = _

"²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"


    Const RegChars As String = _

"2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"


    Dim i As Long

    Dim tempString As String

    Dim currentCharacter As String


    ' Inicializa a string temporária com o valor da string de entrada

    tempString = inputString


    ' Loop pela lista de caracteres acentuados

    For i = 1 To Len(AccChars)

        ' Obtém o próximo caractere acentuado

        currentCharacter = Mid$(AccChars, i, 1)

        ' Substitui pelo caractere correspondente na lista de caracteres regulares

        tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))

    Next i


    ' Retorna a string convertida

    ConvertAccent = tempString

End Function


 Série de Livros nut Project 

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication) eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes

eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Access — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Excel — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Outlook — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Word — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes 


CÓDIGO SIMPLIFICADO

Esta versão usa um dicionário para fazer as substituições, o que simplifica a lógica.


Function ConvertAccent (ByVal inputString As String) As String

    ' Aplicação: Dados base do Power BI.

    ' Ação: Função que retira acentos

    ' Autor: André Bernardes

    ' Contato: andreluizbernardess@gmail.com

    ' Data: 10.07.23 - 15:15:52


    Dim AccChars As String

    Dim RegChars As String

    Dim i As Long

    Dim tempString As String

    Dim charMap As Object


    ' Inicializa os caracteres acentuados e seus correspondentes

    AccChars = "²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"

    RegChars = "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"


    ' Cria um dicionário para mapear os caracteres acentuados para os regulares

    Set charMap = CreateObject("Scripting.Dictionary")


    For i = 1 To Len(AccChars)

        charMap(Mid(AccChars, i, 1)) = Mid(RegChars, i, 1)

    Next i


    tempString = inputString


    ' Substitui os caracteres acentuados pelos correspondentes

    For i = 1 To Len(inputString)

        If charMap.exists(Mid(inputString, i, 1)) Then

            tempString = Replace(tempString, Mid(inputString, i, 1), charMap(Mid(inputString, i, 1)))

        End If

    Next i


    ' Retorna a string convertida

    ConvertAccent = tempString

End Function


 Série de Livros nut Project 

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication) eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes

eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Access — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Excel — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Outlook — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Word — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes 


ABAIXO ESTÁ A VERSÃO DO CÓDIGO QUE É UM POUCO MAIS COMPLEXA PARA A UTILIZAÇÃO DE USUÁRIOS MAIS AVANÇADOS


Esta versão usa matrizes e melhora o desempenho evitando substituições repetidas.


Function ConvertAccent (ByVal inputString As String) As String

    ' Aplicação: Dados base do Power BI.

    ' Ação: Função que retira acentos

    ' Autor: André Bernardes

    ' Contato: andreluizbernardess@gmail.com

    ' Data: 10.07.23 - 15:15:52


Const AccChars As String = "²—­–ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ'"

Const RegChars As String = "2---SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy'"


    Dim i As Long, j As Long

    Dim charMap(1 To 255) As String

    Dim tempString As String

    Dim inputChars() As String

    Dim resultString As String


    ' Preenche o mapa de caracteres

    For i = 1 To Len(AccChars)

        charMap(Asc(Mid(AccChars, i, 1))) = Mid(RegChars, i, 1)

    Next i


    ' Divide a string de entrada em caracteres

    inputChars = Split(StrConv(inputString, vbUnicode), vbNullChar)


    ' Substitui os caracteres acentuados pelos correspondentes

    For i = LBound(inputChars) To UBound(inputChars)

        If Len(charMap(Asc(inputChars(i)))) > 0 Then

            resultString = resultString & charMap(Asc(inputChars(i)))

        Else

            resultString = resultString & inputChars(i)

        End If

    Next i


    ' Retorna a string convertida

    ConvertAccent = resultString

End Function


Essas versões fornecem diferentes níveis de complexidade e desempenho, permitindo que você escolha aquela que melhor se adequar ao seu nível de experiência e necessidades.


  Clique aqui e nos contate via What's App para avaliarmos seus projetos 

Envie seus comentários e sugestões e compartilhe este artigo!
brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project 

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication) eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes

eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Access — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Excel — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 07 - VBA TOP 50 Códigos Mais Importantes - Outlook — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes eBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Word — André Luiz BernardeseBook - PT - Série DONUT PROJECT - Volume 08 - VBA TOP 50 Códigos Mais Importantes - Project — André Luiz Bernardes 

Nenhum comentário:

Postar um comentário

diHITT - Notícias