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
