Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Optimizar este codigo.

26/10/2006 - 18:08 por Alejandro Garcia | Informe spam
Ayuda Hacer una pregunta
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
email Siga el debateRespuesta 4 respuestasRespuesta Tengo una respuesta
DRAGON AGE™: INQUISITION – Matadragones
 

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

Preguntas similares

 

Busqueda sugerida :