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 !

Mostrar la cita
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 __
Mostrar la cita

Preguntas similares

 

Busqueda sugerida :