Disminuir el tiempo de ejecucion de una macro

28/01/2009 - 20:30 por Disminir el tiempo de ejec de una macro | Informe spam
Hola,necesito ayuda con una macro, necesito reducir el tiempo que tarda en
realizar los calculos, pero no se muy bien como empezar. Se trata de una
parte de un cotizador, en donde, se ingresar los datos de los asegurados, y
a partir de estos,la macro, busca la tabala asociada a cada persoa segun el
sexo, y otras condiciones, una vez ahi, la correspondiente tabla , la pega en
otra hoja, y esa hoja , da origen a otra columna, en una tercera hoja,, esos
valores finales son os que pega en la tabla final, en otro libro. mi
idea, es reducir los calculos, ojala poder calcularlos en la macro,y no tener
quecpiar- pegar, pero para eso, tendria que para cada celda ,calcular el
valor asociado, y pegarlo en alguna variable auxiliar.

Ojala puedan ayudarme, estoy desesperada...
Les adjunto el codigo.
Sub GeneradorTab()


i = 0

Do While (i < 9)


Windows("CotizaRV2008_M.xls").Activate
Sheets("Cotizador_Rta_Vit").Select

If (Cells(4 + i, 36) <> "") Then

Windows("GenTablaMej_.xls").Activate
Sheets("Datos").Select
If (Cells(11, 2 + i) = "") Then
Edad_A = 0
Ini_tabla = 0
Mes_Nac = 0
Ano_Nac = 0
Ind_Tab = 0
Else
Edad_A = Cells(11, 2 + i)
Ini_tabla = Cells(15, 2 + i)
Mes_Nac = Cells(9, 2 + i)
Ano_Nac = Cells(10, 2 + i)
Ind_Tab = Cells(4, 2 + i)
sexo = Cells(13, 2 + i)
RicoPobre = Range("b6")
invalidez = Cells(14, 2 + i)
End If


If (i = 0) And (invalidez = "Sano") Then
'causante sano

If (sexo = "Hombre") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 10), Cells.Item(121, 11)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 10), Cells.Item(121, 11)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If


If (sexo = "Mujer") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 12), Cells.Item(121, 13)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 12), Cells.Item(121, 13)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

Else

If (sexo = "Hombre") Then

If (invalidez = "Total") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If

If (invalidez = "Parcial") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

If (invalidez = "Sano") Then


If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 6), Cells.Item(121, 7)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 6), Cells.Item(121, 7)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

End If


If (sexo = "Mujer") Then

If (invalidez = "Total") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If

If (invalidez = "Parcial") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If

If (invalidez = "Sano") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 8), Cells.Item(121, 9)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "SVS"
Sheets("SVS").Select
Range(Cells.Item(11, 8), Cells.Item(121, 9)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

End If

End If
Calculate
Sheets("QxMejorado").Select
Range("b9") = Edad_A
Range("c4") = Ini_tabla
Range("n10") = Mes_Nac
Range("o10") = Ano_Nac
Range("j7") = Ind_Tab
Calculate
Range(Cells.Item(10, 10), Cells.Item(1342, 10)).Select
Selection.Copy
Windows("COTIZARV2008_M.xls").Activate
Sheets("TablasMes").Select
Range(Cells.Item(20, 10 + i), Cells.Item(20, 10 + i)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False




'Genera Tabla CIA con Mejormiento
Windows("GenTablaMej_.xls").Activate

If (i = 0) And (invalidez = "Sano") Then
'causante sano

If (sexo = "Hombre") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 10), Cells.Item(121, 11)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 10), Cells.Item(121, 11)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If


If (sexo = "Mujer") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 12), Cells.Item(121, 13)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 12), Cells.Item(121, 13)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

Else

If (sexo = "Hombre") Then

If (invalidez = "Total") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 2), Cells.Item(121, 3)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Else

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 6), Cells.Item(121, 7)).Select
Selection.Copy
If (Cells.Item(3, 15) = 3) Then
Ind_Tab = 3
End If
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 6), Cells.Item(121, 7)).Select
Selection.Copy
If (Cells.Item(3, 15) = 3) Then
Ind_Tab = 3
End If
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

End If

End If


If (sexo = "Mujer") Then

If (invalidez = "Total") Then

If (RicoPobre = "P") Then
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 4), Cells.Item(121,
5)).Select
Selection.Copy
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Else

If (RicoPobre = "P") Then

Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_P").Select
Range(Cells.Item(11, 8), Cells.Item(121, 9)).Select
Selection.Copy
If (Cells.Item(3, 15) = 3) Then
Ind_Tab = 4
End If
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
Sheets("QxMejorado").Range("d4") = "CIA"
Sheets("CIA_R").Select
Range(Cells.Item(11, 8), Cells.Item(121, 9)).Select
Selection.Copy
If (Cells.Item(3, 15) = 3) Then
Ind_Tab = 4
End If
Sheets("Qx").Select
Range("b30").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

End If

End If

Calculate
Sheets("QxMejorado").Select
Range("b9") = Edad_A
Range("c4") = Ini_tabla
Sheets("QxMejorado").Select
Range("n10") = Mes_Nac
Range("o10") = Ano_Nac
Range("j7") = Ind_Tab
Calculate
Range(Cells.Item(10, 10), Cells.Item(1342, 10)).Select
Selection.Copy
Windows("COTIZARV2008_M.xls").Activate
Sheets("TablasMes").Select
Range(Cells.Item(20, 21 + i), Cells.Item(20, 21 + i)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'Else
' Windows("GenTablaMej_.xls").Activate
' Sheets("Datos").Select
' Edad_A = 0
' Ini_tabla = 0
' Mes_Nac = 0
' Ano_Nac = 0

End If

i = i + 1
Loop
'
End Sub
 

Leer las respuestas

#1 Héctor Miguel
29/01/2009 - 01:51 | Informe spam
hola, 'anonima' !

... necesito ayuda con una macro... reducir el tiempo que tarda en realizar los calculos, pero no se muy bien como empezar...



1) comienza por revisar/validar/... la logica de tus bloques "If...Else...End If", ya que las instrucciones del codigo son las mismas
(o sea, al final de cuentas, puesto que se hace lo mismo resulta que no importa si se cumple -o no- la condicion)
esto podria "adelgazar" tu codigo ~50% de sus lineas -?-

2) puedes evitar que la macro "se la pase saltando" entre libros, hojas y rangos (tus instruciones .Activate, .Select, etc.)
generalmente se puede hacer una referencia "completa" a la ubicacion de la/s celda/s
esto mejoraria el tiempo de ejecucion de tus procesos

3) procura evitar la forma de hacer referencias a los libros usando la propiedad/coleccion: Windows("libro fulano.xls")
algunos sistemas NO muestran la EXTension (en tipos de archivo registrados) como parte del nombre en el menu (ventana)
esto evitaria (posibles) errores por libros (windows) no "encontrados"

si cualquier duda... comentas ?
saludos,
hector.

Preguntas similares