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.

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 

   

    

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 

   

    

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 

   

    

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