¿Por qué el Código de mi Macro se ejecuta lento?
Dante me puedes ayudar en mejorar el código de mi macro porque se ejecuta muy lento, note que se se puso lento cuando le agregue los códigos para convertir las fechas, te adjunto el código y la imagen sobre la hoja que estoy trabajando con más de 6,000 filas, Saludos.
CODIGO:
Sub Ciclos()
Range("B10").EntireColumn.Insert
Range("B10").EntireColumn.Insert
Range("B10").EntireColumn.Insert
Range("B10").EntireColumn.Insert
Dim fila As Integer
fila = 10
Do While Cells(fila, 1) <> ""
Cells(fila, 2).FormulaR1C1 = "1"
Cells(fila, 3).FormulaR1C1 = "2018"
Cells(fila, 4).FormulaR1C1 = "=DATE(RC[-1],RC[-2],RC[-3])"
Columns("D:D").EntireColumn.AutoFit
Cells(fila, 4).Select
Selection.Copy
Cells(fila, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
fila = fila + 1
Loop
End Sub
2 respuestas
Le hice cambios a tu macro. Prueba con lo siguiente:
Sub Poner_Datos()
'Act.Por Dante Amor
Application.ScreenUpdating = False
Range("B:E").EntireColumn.Insert
u = Range("A" & Rows.Count).End(xlUp).Row
Range("B10:B" & u).Value = 1
Range("C10:C" & u).Value = 2018
Range("D10:D" & u).Formula = "=DATE(RC[-1],RC[-2],RC[-3])"
Range("D10:D" & u).Copy
Range("E10").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub'.[Sal u dos. No olvides valorar la respuesta.
Checa los resultados de esta macro, proceso casi 16000 filas en 1 segundo
y esta es la macro
Sub poner_fechas()
inicio = Time
Set datos = Range("a10").CurrentRegion
Range("b2").Resize(1, 4).EntireColumn.Insert
With datos
r = .Rows.Count
.Columns(2) = 1
.Columns(3) = 2018
dia = .Cells(1, 1).Address(False, False)
mes = .Cells(1, 2).Address(False, False)
año = .Cells(1, 3).Address(False, False)
.Columns(4).Resize(r, 1).Formula = "=date(c10,a10,b10)"
.Columns(5).Value = .Columns(4).Value
.Columns(4).Resize(r, 2).NumberFormat = "m/d/yyyy"
End With
Set datos = Nothing
fin = Time
tiempo = fin - inicio
MsgBox (r & " filas procesadas en " & Second(tiempo) & " segundos"), vbInformation, "AVISO"
End Sub