Macro Eliminar caracteres acentuados en Excel

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
Gracias por permitirme aprender
Al contrario. Estoy agradecido de que estos conocimientos puedan aprovecharse para la comunidad.
Gracias,
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
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 !!
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.