Ayuda con macro interesante para limpiar archivos de texto importados

22/04/2005 - 12:14 por mukelemulembe | Informe spam
Hola a todos!

He creado una macro para "limpiar" archivos importados de texto. Me
explico, cuando importo archivos .txt ciertos caracteres no los importa
bien. Por ejemplo la ñ. Me he creado una macro para sustituir estos
caracteres por los que corresponden y ahora la intento poner en un libro
de macros personal. No me funciona bien para otros libros abiertos, pero
por lo que vero en el código de VB (no tengo ni idea de VB, pero entiendo
algo de inglés), no debe de ser muy difícil de adaptar para que funcione
en la hoja abierta y no necesite de la hoja "Aux". Además puede que les
sirva a otros usuarios que, después de haberme beneficiado tanto de este
foro (me habéis ahorrado horas de trabajo), me gustaría contribuir con
algo. En fin aquí la tenéis por si queréis adaptarla y utilizarla, gracias
de antemano.

Joel.

Public Function Limpiar()
'
' Limpiar Macro
' Macro grabada el 16/11/2004 por USUARIO
'
' Acceso directo: CTRL+l
'
Sheets("Aux").Select
Range("A1").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="¡", Replacement:="í", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A2").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="¢", Replacement:="ó", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A3").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="‚", Replacement:="é", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A4").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="§", Replacement:="º", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A5").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="¥", Replacement:="Ñ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A6").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:=" ", Replacement:="á", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A7").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="€", Replacement:="ñ", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A8").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="‡", Replacement:="ç", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
Sheets("Aux").Select
Range("A9").Select
Selection.Copy
Sheets("Datos").Select
Application.CutCopyMode = False
Cells.Replace What:="£", Replacement:="ú", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False
End Sub
 

Leer las respuestas

#1 KL
22/04/2005 - 12:46 | Informe spam
Hola Joel,

Prueba el codigo que te pongo a continuacion.

Saludos,
KL

Public Sub Limpiar()
Dim Orig As Variant, Sust As Variant, i As Integer
Orig = Array("¡", "¢", "?", "§", "¥", " ", "¤", "?", "£")
Sust = Array("í", "ó", "é", "º", "Ñ", "á", "ñ", "ç", "ú")
Application.ScreenUpdating = False
For i = LBound(Orig) To UBound(Orig)
ActiveSheet.Cells.Replace _
What:=Orig(i), _
Replacement:=Sust(i), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False
Next i
Application.ScreenUpdating = True
End Sub

Preguntas similares