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

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

Você tem direito as informações da sua empresa

MIS - Usufruindo a excelência na análise das suas Informações

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Key Performance Indicators - 7 Características desejáveis

Tópicos relacionados:

Business English - Termos em inglês do mundo dos negócios - Speaking the lingo

Acrônimos - Technology, Electronics and Games Acronyms

13 Dicas para se Falar em Público

Os 10 mandamentos do gerenciamento de projetos

KPI - Key Performance Indicator

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

Tags: VBA, XML, Tips, rename, caracter, character, acentuado, MSXML