VBA Excel para Retroactivos

Expertos buenos días,

Estoy elaborando un proyecto para el calculo de retroactivos de mi empresa, la solución que encontré no esta mal pero me gustaría adicionarle algunas instrucciones donde algunas veces tengo problema. A continuación el detalle y mi rutina actual:

A grandes rasgos tengo un libro con 3 hojas: "DETALLESBI", "HISTOCONTR" y "Configuración".

*DETALLESBI es mi reporte de ventas

*HISTOCONTR es el histórico de cambios de precio pieza que vendemos.

*Configuración es una hoja donde en la columna A coloco los números de parte de las piezas que quiero calcular.

Como la información es extensa debo identificar las piezas en el DETALLESBI y en el HISTOCONTR y esto lo hago por medio de las siguientes formulas:

=SI(ESERROR(BUSCARV(C2,Configuración!A:A,1,0)=VERDADERO),"","Calcular Retroactivo")

=SI(ESERROR(BUSCARV(D2,Configuración!A:A,1,0)=VERDADERO),"","Calcular Retroactivo")

Una vez que alimento la información de las 3 hojas mi rutina coloca un filtro en las hojas DETALLESBI y HISTOCONTR para filtrar aquellas piezas que contiene el texto "Calcular Retroactivo"; Una vez hecho esto la información filtrada la paso a un segundo archivo llamado Calculo de Retroactivo.xlsm que en realidad es el mismo que el original (Retroactivo 2012.xlsm) solo que tiene adicionada una formula matricial para lo que en breve les describirey lo guarda con el nombre Detalle de Retroactivo.xlsm para no guardar los cambios.

La intención es poder tener solo la información necesaria para buscar en la hoja HISTOCONTR el precio que se tenia vigente al momento de la venta de una pieza en determinada fecha según la hoja DETALLESBI, la formula para calcular esto es la siguiente:

={SUMA((HISTOCONTR!$C$2:$C$1048576=DETALLE!B2)*(DETALLE!O2>=HISTOCONTR!$I$2:$I$1048576)*(DETALLE!O2<=HISTOCONTR!$J$2:$J$1048576)*(HISTOCONTR!$QUE$2:$QUE$1048576))}

Necesito de su ayuda para encontrar la rutina adecuada para optimizar mi proyecto y:

*Eliminar unicamente las filas de cada hoja que no contenga el texto "Calcular Retroactivo" (Columna A en ambas hojas)

*Calcular por medio de VBA el reteroactivo con una solución similar u optimizada de la que les presente de las piezas que resulte para calcular. A continuación la ruitina que sinceramente con esfuerzo genere:

Sub CALCULO()
'
' CALCULO Macro
'
'
Application.ScreenUpdating = False
Sheets("DETALLESBI").Select
Cells.Select
Selection.AutoFilter
Sheets("HISTOCONTR").Select
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$1048576").AutoFilter Field:=1, Criteria1:="<>"
Sheets("DETALLESBI").Select
ActiveSheet.Range("$A$1:$P$1048576").AutoFilter Field:=1, Criteria1:="<>"
Workbooks.Open Filename:= _
"Z:\Usuarios\Finanzas\CUENTAS POR COBRAR\Herramienta Retroactivo\Calculo de Retroactivo.xlsm"
Windows("Retroactivo 2012.xlsm").Activate
Columns("B:P").Select
Selection.Copy
Windows("Calculo de Retroactivo.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Windows("Retroactivo 2012.xlsm").Activate
Sheets("HISTOCONTR").Select
Columns("B:L").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Calculo de Retroactivo.xlsm").Activate
Sheets("HISTOCONTR").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("DETALLESBI").Select
Columns("A:O").Select
Sheets("DETALLE").Select
Columns("A:O").Select
Range("O1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Sheets("DETALLESBI").Select
Selection.Copy
Sheets("DETALLE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Sheets("DETALLESBI").Select
Range("A1").Select
ActiveWorkbook.SaveAs Filename:= _
"Z:\Usuarios\Finanzas\CUENTAS POR COBRAR\Herramienta Retroactivo\Detalle de Retroactivo.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
Range("A1").Select
ThisWorkbook.Close savechanges:=False
End Sub

Toda mejora, replanteo o solución es bienvenida y muy agradecida. Gracias por su tiempo Expertos.

Edgar Ureña / [email protected]

Añade tu respuesta

Haz clic para o