Optimizar este codigo.

26/10/2006 - 18:08 por Alejandro Garcia | Informe spam
Tengo este codigo que deseo optimiar y colocarle un par de cosillas que
no se como hacer. Lo que deseo agregar es que al final me diga si se
hizo reemplazos o no en el archivo que estoy aplicando. Y otro punto es
que este codigo me quede fijo para cualquier libro que abra en Excel.

Le agradezco

Sub Reemplazar()
'Coloco los meses en ingles al castellano
Cells.Replace What:="-Jan-", Replacement:="-Ene-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Apr-", Replacement:="-Abr-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Aug-", Replacement:="-Ago-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Dec-", Replacement:="-Dic-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
'Reemplazo de letras no aceptadas en el archivo
Cells.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Á", Replacement:="A", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="É", Replacement:="E", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Í", Replacement:="I", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Ó", Replacement:="O", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Ú", Replacement:="U", LookAt:=xlPart, SearchOrder
_
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:=".", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
End Sub

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
27/10/2006 - 03:09 | Informe spam
hola, Alejandro !

Tengo este codigo que deseo optimiar y colocarle un par de cosillas que no se como hacer.
Lo que deseo agregar es que al final me diga si se hizo reemplazos o no en el archivo que estoy aplicando.
Y otro punto es que este codigo me quede fijo para cualquier libro que abra en Excel.



1) para que puedas usar el mismo codigo en varios libros... te sugiero buscar en el foro por el libro de macros 'persona.xls' :D

2) por lo del codigo que necesitas 'adaptar'... prueba con algo +/- como lo siguiente:

Sub Reemplazar()
Dim Busca, Reemplaza, Sig As Byte, Parcial As Integer, Total As Long, Msj As String
Busca = Array("-Jan-", "-Apr-", "-Aug-", "-Dec-", "Ñ", "Á", "É", "Í", "Ó", "Ú", ".")
Reemplaza = Array("-Ene-", "-Abr-", "-Ago-", "-Dic-", "N", "A", "E", "I", "O", "U", "")
ReDim Sustituciones(UBound(Busca))
With ActiveSheet
For Sig = LBound(Busca) To UBound(Busca)
Parcial = Application.CountIf(.UsedRange, "*" & Busca(Sig) & "*")
Sustituciones(Sig) = Parcial
If Parcial Then
Total = Total + Parcial
.Cells.Replace Busca(Sig), Reemplaza(Sig)
End If
Next
End With
If Total = 0 Then MsgBox "No se hicieron reemplazos.": Exit Sub
Msj = "Se hicieron reemplazos en " & Total & " celdas como sigue:"
For Sig = LBound(Busca) To UBound(Busca)
Parcial = Sustituciones(Sig)
If Parcial Then
Msj = Msj & vbCr & Parcial & " de: " & Busca(Sig)
End If
Next
MsgBox Msj
End Sub

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

__ el codigo expuesto __
Sub Reemplazar()
'Coloco los meses en ingles al castellano
Cells.Replace What:="-Jan-", Replacement:="-Ene-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="-Apr-", Replacement:="-Abr-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="-Aug-", Replacement:="-Ago-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="-Dec-", Replacement:="-Dic-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Reemplazo de letras no aceptadas en el archivo
Cells.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Á", Replacement:="A", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="É", Replacement:="E", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Í", Replacement:="I", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ó", Replacement:="O", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Ú", Replacement:="U", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:=".", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
Respuesta Responder a este mensaje
#2 Alejandro Garcia
27/10/2006 - 14:24 | Informe spam
Gracias Hector, ok tu macro esta mejor optimizada que la mia, pero hay
un problema, la garbo en mi libro Personal.xls, como me indicas, pero
si abro un libro y ejecuto la macro me dice que no hay reemplazos pero
si hay caracteres para reemplazar, ¿que podra ser?.

Otro detalle, si yo desde un programa externo envio un reporte a Excel
no me abre el libro Personal.xls y por ocnisguiente no tengo acceso a
la macro. ¿Esta ultima a que se debera?. Trabajo con un programa hecho
en Vfp el cual me permite exportar los listados a Excel, abriendo este
inmediatamente, a eso me refiero.

Gracias.

hola, Alejandro !

Tengo este codigo que deseo optimiar y colocarle un par de cosillas que no
se como hacer.
Lo que deseo agregar es que al final me diga si se hizo reemplazos o no en
el archivo que estoy aplicando.
Y otro punto es que este codigo me quede fijo para cualquier libro que abra
en Excel.



1) para que puedas usar el mismo codigo en varios libros... te sugiero buscar
en el foro por el libro de macros 'persona.xls' :D

2) por lo del codigo que necesitas 'adaptar'... prueba con algo +/- como lo
siguiente:

Sub Reemplazar()
Dim Busca, Reemplaza, Sig As Byte, Parcial As Integer, Total As Long, Msj
As String
Busca = Array("-Jan-", "-Apr-", "-Aug-", "-Dec-", "Ñ", "Á", "É", "Í", "Ó",
"Ú", ".")
Reemplaza = Array("-Ene-", "-Abr-", "-Ago-", "-Dic-", "N", "A", "E", "I",
"O", "U", "")
ReDim Sustituciones(UBound(Busca))
With ActiveSheet
For Sig = LBound(Busca) To UBound(Busca)
Parcial = Application.CountIf(.UsedRange, "*" & Busca(Sig) & "*")
Sustituciones(Sig) = Parcial
If Parcial Then
Total = Total + Parcial
.Cells.Replace Busca(Sig), Reemplaza(Sig)
End If
Next
End With
If Total = 0 Then MsgBox "No se hicieron reemplazos.": Exit Sub
Msj = "Se hicieron reemplazos en " & Total & " celdas como sigue:"
For Sig = LBound(Busca) To UBound(Busca)
Parcial = Sustituciones(Sig)
If Parcial Then
Msj = Msj & vbCr & Parcial & " de: " & Busca(Sig)
End If
Next
MsgBox Msj
End Sub

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

__ el codigo expuesto __
Sub Reemplazar()
'Coloco los meses en ingles al castellano
Cells.Replace What:="-Jan-", Replacement:="-Ene-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Apr-", Replacement:="-Abr-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Aug-", Replacement:="-Ago-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="-Dec-", Replacement:="-Dic-", LookAt:=xlPart,
SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
'Reemplazo de letras no aceptadas en el archivo
Cells.Replace What:="Ñ", Replacement:="N", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Á", Replacement:="A", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="É", Replacement:="E", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Í", Replacement:="I", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Ó", Replacement:="O", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:="Ú", Replacement:="U", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Cells.Replace What:=".", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
End Sub
Respuesta Responder a este mensaje
#3 Héctor Miguel
27/10/2006 - 19:16 | Informe spam
hola, Alejandro !

__ 1 __
... un problema, la garbo en mi libro Personal.xls
... pero si abro un libro y ejecuto la macro me dice que no hay reemplazos pero si hay caracteres para reemplazar, que podra ser?.



1) [segun las pruebas]... con la instruccion de: -> With ActiveSheet
me ha funcionado para cualquier libro sin importar si se trata del que contiene la macro -?-

__ 2 __
Otro detalle, si yo desde un programa externo envio un reporte a Excel no me abre el libro Personal.xls...
... Trabajo con un programa hecho en Vfp... exportar los listados a Excel, abriendo este inmediatamente...



2) [hasta donde se]... cuando excel es abierto como 'instancia provocada por mecanismos de automatizacion' [desde otra aplicacion]
excel no tiene 'control total de sus habilidades' [es decir]... no se cargan los complementos instalados, NI el personal.xls, NI... :-((
-> sera necesario que manejes el reporte 'directamente' desde excel :D

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.
Respuesta Responder a este mensaje
#4 Alejandro Garcia
27/10/2006 - 23:25 | Informe spam
Gracias Hector, despejaste todas mis dudas, tendre que primero grabar
el archivo que me arroja el programa Vfp, y posteriormente abrirlo con
Excel y asi aplicarle la rutina que esta arriba.

Gracias mil por tus consejos siempre oportuno.

hola, Alejandro !

__ 1 __
... un problema, la garbo en mi libro Personal.xls
... pero si abro un libro y ejecuto la macro me dice que no hay reemplazos
pero si hay caracteres para reemplazar, que podra ser?.



1) [segun las pruebas]... con la instruccion de: -> With ActiveSheet
me ha funcionado para cualquier libro sin importar si se trata del que
contiene la macro -?-

__ 2 __
Otro detalle, si yo desde un programa externo envio un reporte a Excel no
me abre el libro Personal.xls...
... Trabajo con un programa hecho en Vfp... exportar los listados a Excel,
abriendo este inmediatamente...



2) [hasta donde se]... cuando excel es abierto como 'instancia provocada por
mecanismos de automatizacion' [desde otra aplicacion]
excel no tiene 'control total de sus habilidades' [es decir]... no se
cargan los complementos instalados, NI el personal.xls, NI... :-((
-> sera necesario que manejes el reporte 'directamente' desde excel :D

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida