Macro Eliminar caracteres acentuados en Excel

Twittear este post  Compartir en Facebook

La siguiente macro permite eliminar todos los caracteres acentuados del rango seleccionado. Esto facilita la manipulación y comparación de textos, ya que por lo regular es recomendable utilizar texto sin acentuaciones en bases de datos:

Macro:

Sub EXCELeINFOReplaceAccentedCharacters()
Application.StatusBar = "Reemplazando caracteres acentuados..."
Application.ScreenUpdating = False
'
With Selection
'a
    .Replace What:="á", Replacement:="a", MatchCase:=True
    .Replace What:="à", Replacement:="a", MatchCase:=True
    .Replace What:="â", Replacement:="a", MatchCase:=True
    .Replace What:="ä", Replacement:="a", MatchCase:=True
    .Replace What:="ã", Replacement:="a", MatchCase:=True
    .Replace What:="å", Replacement:="a", MatchCase:=True
'c
    .Replace What:="ç", Replacement:="c", MatchCase:=True
'e
    .Replace What:="é", Replacement:="e", MatchCase:=True
    .Replace What:="è", Replacement:="e", MatchCase:=True
    .Replace What:="ê", Replacement:="e", MatchCase:=True
    .Replace What:="ë", Replacement:="e", MatchCase:=True
'i
    .Replace What:="í", Replacement:="i", MatchCase:=True
    .Replace What:="ì", Replacement:="i", MatchCase:=True
    .Replace What:="î", Replacement:="i", MatchCase:=True
    .Replace What:="ï", Replacement:="i", MatchCase:=True
'o
    .Replace What:="ó", Replacement:="o", MatchCase:=True
    .Replace What:="ò", Replacement:="o", MatchCase:=True
    .Replace What:="ô", Replacement:="o", MatchCase:=True
    .Replace What:="ö", Replacement:="o", MatchCase:=True
    .Replace What:="õ", Replacement:="o", MatchCase:=True
    .Replace What:="ð", Replacement:="o", MatchCase:=True
's
    .Replace What:="š", Replacement:="s", MatchCase:=True
'u
    .Replace What:="ú", Replacement:="u", MatchCase:=True
    .Replace What:="ù", Replacement:="u", MatchCase:=True
    .Replace What:="û", Replacement:="u", MatchCase:=True
    .Replace What:="ü", Replacement:="u", MatchCase:=True
'y
    .Replace What:="ý", Replacement:="y", MatchCase:=True
    .Replace What:="ÿ", Replacement:="y", MatchCase:=True
'z
    .Replace What:="ž", Replacement:="z", MatchCase:=True
'A
    .Replace What:="Á", Replacement:="A", MatchCase:=True
    .Replace What:="À", Replacement:="A", MatchCase:=True
    .Replace What:="Â", Replacement:="A", MatchCase:=True
    .Replace What:="Ä", Replacement:="A", MatchCase:=True
    .Replace What:="Ã", Replacement:="A", MatchCase:=True
    .Replace What:="Å", Replacement:="A", MatchCase:=True
'C
    .Replace What:="Ç", Replacement:="C", MatchCase:=True

    .Replace What:="É", Replacement:="E", MatchCase:=True
    .Replace What:="È", Replacement:="E", MatchCase:=True
    .Replace What:="Ê", Replacement:="E", MatchCase:=True
    .Replace What:="Ë", Replacement:="E", MatchCase:=True
'I
    .Replace What:="Í", Replacement:="I", MatchCase:=True
    .Replace What:="Ì", Replacement:="I", MatchCase:=True
    .Replace What:="Î", Replacement:="I", MatchCase:=True
    .Replace What:="Ï", Replacement:="I", MatchCase:=True
'O
    .Replace What:="Ó", Replacement:="O", MatchCase:=True
    .Replace What:="Ò", Replacement:="O", MatchCase:=True
    .Replace What:="Ô", Replacement:="O", MatchCase:=True
    .Replace What:="Ö", Replacement:="O", MatchCase:=True
    .Replace What:="Õ", Replacement:="O", MatchCase:=True
    .Replace What:="Ð", Replacement:="O", MatchCase:=True
'S
    .Replace What:="Š", Replacement:="S", MatchCase:=True
'U
    .Replace What:="Ú", Replacement:="U", MatchCase:=True
    .Replace What:="Ù", Replacement:="U", MatchCase:=True
    .Replace What:="Û", Replacement:="U", MatchCase:=True
    .Replace What:="Ü", Replacement:="U", MatchCase:=True
'Y
    .Replace What:="Ý", Replacement:="Y", MatchCase:=True
    .Replace What:="Ÿ", Replacement:="Y", MatchCase:=True
'Z
    .Replace What:="Ž", Replacement:="Z", MatchCase:=True
End With
'
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

You may also like...

6 Responses

  1. Salvador says:

    Gracias por permitirme aprender

  2. Anonimo says:

    Gracias,

  3. Obed Cruz says:

    Excelente Blog estimado,

    Te agrego una UDF que hace la misma función, a alguien le podría servir.

    Option Explicit

    Function SinAcentos(Celda)
    Dim temp, strA$, strB$, i&, p&
    strA = “áàäâãåçéèêëíìîïóòôöõðšúùûüýÿž” & _
    “ÁÀÄÂÃÅÇÉÈÊËÍÌÎÏÓÒÔÖÕЊÚÙÛÜÝŸŽ ”
    strB = “aaaaaaceeeeiiiioooooosuuuuyyz” & _
    “AAAAAACEEEEIIIIOOOOOOSUUUUYYZ”
    temp = Celda

    For i = 1 To Len(temp)
    p = InStr(strA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(strB, p, 1)
    Next

    SinAcentos = temp

    End Function

    • sergioacamposh says:

      Gracias por el dato Obed.

      El código es de tu autoría ?? De ser así me permites añadirlo como un nuevo post ??

      Saludos !!

  4. Obed Cruz says:

    Es correcto Sergio, yo soy el autor del código.
    Y tienes toda la libertad de añadirlo en tu post.

    Esta el la liga dónde lo publiqué en mi blog.

    http://www.o-cruzg.blogspot.com/2011/11/f-para-eliminar-acentos-udfotra-f.html

    Saludos.

Leave a Reply

Your email address will not be published. Required fields are marked *

%d bloggers like this: