✔ Programação GLOBAL®: VBA Tips - Removendo caracteres especiais de uma palavra

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

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Acesse: http://goo.gl/0v6AO

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