✔ VBA Dashboards Specialist®: VBA Tips - Removendo caracteres especiais de uma palavra

19 de dezembro de 2012

VBA Tips - Removendo caracteres especiais de uma palavra - Remove and replace special characters

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Ao processar um arquivo XML a partir da web tive alguns caracteres especiais, parecidos aos mostrados abaixo, mas o analisador MSXML recusou-se a aceitá-los. Precisaram ser convertidos ao normal (ou seja, sem sotaque) antes que possam ser analisados pelo XML.

Referio-me aos caracteres acentuados que se parecem com isto: é, ñ, André.

Aqui está uma ligeira adaptação do código. Basta passar como parâmetro qualquer seqüência que desejar expurgar; quaisquer caracteres estranhos serão substituídos por seus equivalentes não-acentuados. Poderá usar este código como uma Função VBA numa planilha, bem como em outros aplicativos da suíte MS Office.

Este código tem algumas pequenas variações, por exemplo, em vez de sempre efetuar um loop através da lista de caracteres acentuados, ele percorre a cadeia de entrada que for mais curta.

Function ConvertAccent (ByVal inputString As String) As String

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

Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long

Let tempString = inputString

' loop through the shorter string

Select Case True
Case Len(AccChars) <= Len(inputString)
' accent character list is shorter (or same)

' loop through accent character string
For i = 1 To Len(AccChars)

' get next accent character

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

' replace with corresponding character in "regular" array
If InStr(tempString, currentCharacter) > 0 Then
  Let tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))
End If

Next i
Case Len(AccChars) > Len(inputString)
' input string is shorter

' loop through input string
For i = 1 To Len(inputString)

' grab current character from input string and

' determine if it is a special char
  Let currentCharacter = Mid$(inputString, i, 1)
  Let found = (InStr(AccChars, currentCharacter) > 0)

If found Then

' find position of special character in special array
  Let foundPosition = InStr(AccChars, currentCharacter)

' replace with corresponding character in "regular" array

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

End If
Next i
End Select

  Let ConvertAccent = tempString
End Function

Se a lista de caracteres acentuados for mais curta (o cenário mais provável), então dê um nó laço com ele e dê a cada carácter a uma variável String. Se existir na cadeia de entrada, o caractere acentuado será substituído com o carácter na lista de seqüência regular, mesmo se ele for encontrado várias vezes (a função Replace). Portanto, independentemente do tamanho da cadeia de entrada, o circuito só será executada 60 vezes (o número de caracteres acentuados) por String.

Se a lista de caracteres acentuados for maior, então ocorrerá um loop através da cadeia de entrada. Cada carácter será pego e atribuído a uma variável String. Se for encontrado na lista de caracteres acentuados, será substituído com o caractere correspondente na lista de cadeia normal. Mesmo que a lista de caracteres acentuados contenha 60 caracteres, o loop só irá executar n vezes (o número de caracteres na cadeia de entrada).

Segue um código variante:

Function ConvertAccent2 (ByVal inputString As String) As String
Dim X As Long, Position As Long

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

"SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

For X = 1 To Len(inputString)

Let Position = InStr(AccChars, Mid(inputString, X, 1))

If Position Then Mid(inputString, X) = Mid(RegChars, Position, 1)

Next

Let ConvertAccent = inputString
End Function