Macro para quitar los caracteres extraños y poner acentos y ñ

Esta macro fue generada por ChatGPT y la comparto por este medio:

Sub ReemplazarCaracteres()
    Dim rango As Range
    Set rango = ActiveSheet.UsedRange
    
    'Reemplazar caracteres raros por letras con acento y Ñ
    rango.Replace What:="»A", Replacement:="á", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã‰", Replacement:="é", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã", Replacement:="í", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã“", Replacement:="ó", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ãš", Replacement:="ú", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã¡", Replacement:="á", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã©", Replacement:="é", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã", Replacement:="í", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã³", Replacement:="ó", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ãº", Replacement:="ú", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Â°", Replacement:="º", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Âª", Replacement:="ª", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Âº", Replacement:="º", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã±", Replacement:="Ñ", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã½", Replacement:="ý", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã¼", Replacement:="ü", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Ã‘", Replacement:="Ñ", LookAt:=xlPart, MatchCase:=True
    rango.Replace What:="Î¼", Replacement:="µ", LookAt:=xlPart, MatchCase:=True
End Sub

Simplemente hay que generar una Macro con este código, seleccionar las columnas que queramos «arreglar», ejecutar la macro y listo.

Deja una respuesta Cancelar la respuesta