Reducir formulación de macro, se ejecuta muy lento..

Para ejecutar la macro final depende de varias macros adicionales, la cual se demora en hacer el proceso, por lo cual pido su apoyo en poder disminuir todo el procesos, estas son las macros de acuerdo a cada procesos:

MACRO FINAL:

Sub Compra_Elimina_Hoja_Pegar_con_VBA()
Application.ScreenUpdating = False
Hoja21.Cells.Clear

Worksheets("CABECERA").Range("A2:AM4").Copy _
Worksheets("CONCAR").Range("A1")

Worksheets("COMPRAS").Range("F8:F300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E4:F294").Select
Selection.NumberFormat = "m/d/yyyy"
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("O8:O300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("H8:H300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294"), Type:=xlFillDefault
Range("J4:J294").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0),"""")"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294")
Range("J4:J294").Select
Selection.Copy
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Worksheets("COMPRAS").Range("L8:L300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Worksheets("COMPRAS").Range("AC8:AC300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("K4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Worksheets("COMPRAS").Range("C8:C300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Worksheets("COMPRAS").Range("O8:O300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("M4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Worksheets("COMPRAS").Range("AZ8:AZ300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("N4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AY8:AY300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("O4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("Q8:R300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("P4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("Z8:Z300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("S4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("W8:W300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("R4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AR8:AR300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("X4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Call Concatenar
Worksheets("COMPRAS").Range("AX8:AX300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("Y4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Call LIMPIAR
Worksheets("COMPRAS").Range("AV8:AW300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("AA4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Range("W8").Select
Sheets("CONCAR").Select
Range("R4").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Application.ScreenUpdating = True
FRM_LISTO.Show
End Sub

MACRO ADICIONAL 1:

Sub Concatenar()
fila = 8
Do While Range("AA" & fila) <> ""
Range("AX" & fila) = "=CONCATENATE(IF(RC[-5]="""","""",TEXT(RC[-5],""0000-"")),IF(RC[-5]="""","""",""-""),RC[-3])"
fila = fila + 1
Loop

End Sub

MACRO ADICIONAL 2:

Sub LIMPIAR()
If ActiveSheet.Index = 4 Then
CUO = Hoja8.Range("AQ1")
Hoja8.Range("AX8:AX" & CUO).Value = ""
End If
End Sub

2 Respuestas

Respuesta
1

[Hola

El uso de Select no es necesario y hace más lentos los procesos:

https://abrahamexcel.blogspot.com/2017/12/el-uso-y-abuso-de-select-y-selection-en.html 

Por ejemplo, todo esto:

Worksheets("COMPRAS").Range("F8:F300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Debe ser reemplazado por esto:

Worksheets("COMPRAS").Range("F8:F300").Copy
With Worksheets("CONCAR")
    .Range("E4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("F4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

O esto:

Range("E4:F294").Select
Selection.NumberFormat = "m/d/yyyy"

Por esto:

Range("E4:F294"). NumberFormat = "m/d/yyyy"

Y tienes varios así, solo haz lo mismo que te pongo de ejemplo.

Prueba y vas comentando.

Abraham Valencia

PD: Se pueden hacer más cosas incluso pero, paso a paso

Hola Abraham, ante todo agradezco el tiempo que me das a dar respuesta en lo solicitado, aun no he probado lo comentado por tu persona, pero si observas un poco en todo este proceso es que tengo una base de datos que copio de una hoja a otra, pero las columnas tiene un límite de datos, no se como indicar que es hasta la celda F300 o menor o mayor numero de celda, he colocado un standard pero este standard puede aumentar haciendo que de un momento a otro modifique.

A la vez pediría tu ayuda en disminuir todo la estructura de la macro y así puede tener una estructura más corta y no como lo estoy planteando hasta el momento, a la vez haré las modificaciones que me indicas y te confirmo como me va. Pero como te indique quisiera que todo los procesos este en una estructura y no en dos si observas en la MAcro final hago que llame una macro adicional.

Gracias

Como hacer para rangos no fijos:

Dim UltimaFila As Long
Let UltimaFila = Worksheets("COMPRAS").Cells(Rows.Count, 6).End(xlUp).Row
Worksheets("COMPRAS").Range("F8:F" & UltimaFila).Copy
With Worksheets("CONCAR")
    .Range("E4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("F4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End With

¿Ves el 6? Es por la columna "F", por si acaso. Otra cosa, estoy asumiendo que sí o sí los datos comienzan, en este caso, siempre en "F8" (¿lo ves también?).

Sobre tener todo en una macro, pues de lo que se ve, bastaría cortar/pegar los códigos de tus "macros adicionales" y colocarlos en las líneas respectivas de tu "macro principal".

Abraham Valencia

Hola Abraham:

Disculpa por la demora en dar una respuesta a la solución del caso, la primera variable me ejecuto sin ningún inconveniente, pero al momento de adicionar que el formato se valor fecha hace los siguiente:

Worksheets("COMPRAS").Range("F8:F300").Copy

With Worksheets("CONCAR")
.Range("E4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("E4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("E4:F294").NumberFormat = "m/d/yyyy"

1.- La hoja Compras es la hoja de data, y la hoja Concar es donde se debe pegar la información.

2.- Al ejecutar este procesos hace que si copie la información, pero da el formato de fecha en la hoja Compras y no en la Hoja de Concar, no se si he modificado correctamente.

Agradezco tu apoyo.

Saludos.

Aunque solo colocas un retazo, aparentemente sí se da el formato en la hoja "Concar", a menos que en lo que no colocas haga algo que lo anula.

Abraham Valencia

Hola Abraham:

Ya encontré la solución gracias.

Al inicio no le había puesto el punto:

Range("E4:F294").NumberFormat = "m/d/yyyy"

y revisando lo coloque:

.Range("E4:F294").NumberFormat = "m/d/yyyy"

Esto hizo que el proceso sea correcto.

Saludos

Hola Abraham:

Esta realizando la modificación de la fórmula para rango no fijo pero tengo esta secuencia de macro y no se como reducir cuando se pega a la hoja adicional

Worksheets("COMPRAS").Range("H8:H300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294"), Type:=xlFillDefault
Range("J4:J294").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0),"""")"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294")
Range("J4:J294").Select
Selection.Copy
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Agradezco tu apoyo.

Saludos.

[Hola

Ya te lo había comentado:

Hola Abraham:

Agradezco tu apoyo en la solución del caso, si ya realice el procedimiento pero la observación es hasta:

Worksheets("COMPRAS").Range("H8:H300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Pero cuando la información se copia a la hoja CONCAR antes hace un buscarv de otra hoja para obtener un código y posterior pega a la hoja CONCAR pero al realizar este procedimiento todo queda en la hoja COMPRAS o no ejecuta, por eso realizo nuevamente la consulta. La hoja que hace el buscarv es CABECERA.

Range("J4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294"), Type:=xlFillDefault
Range("J4:J294").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0),"""")"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294")
Range("J4:J294").Select
Selection.Copy
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select

Agradeciendo de antemano tu apoyo.

Saludos.

Intentaste con:

Worksheets("Concar").Range("J4").FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"

Trata de entender los códigos y no olvides que si no colocas el nombre de la hoja de una celda, para el VBA se hace referencia a la hoja activa, por tanto, ahí hace las cosas que se le indican. O sea, esto:

ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"

Es igual a poner esto:

Activesheet.ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"

Saludos]

Abraham Valencia

Respuesta
1

A la muy buena respuesta de Abraham sugiero que además pases el cálculo a modo manual si la hoja está muy formulada... y al finalizar se vuelve a modo automático. Esto evita que se recalcule ante cada pase.

Por ej:

Al inicio de cada macro adicional colocar:   Application.Calculation = xlManual

Y antes del End Sub:  Application.Calculation = xlAutomatic

También comento acerca del no uso de Select en el video 11 de mi canal.

Sdos y no olvides valorar las respuestas.

Elsa

Buenos días Elsa:

Al colocar este hace que mis datos originales pases en formato texto, y como hago para que paseen formato fecha si al pasar me sale en numero.

Gracias

Las líneas de código te las pasó Abraham... debes dejarle los comentarios/aclaraciones a él. Mi respuesta ya quedó cerrada.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas