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

6 thoughts on “Macro Eliminar caracteres acentuados en Excel”

  1. 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

    1. sergioacamposh

      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 !!

Leave a Comment

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

Scroll to Top