¿Qué le ocurre a la macro que creé para Microsoft excel que sigue sin funcionar?
Que tal tengo una duda:
Revise la macro que me diste y le hice algunas modificaciones y quedo así:
Sub CopiarPorColorFondo()
Dim c As Range
Dim lin1 As Integer
lin1 = 1
Range("A1").Select
Selection.CurrentRegion.Select
For Each c In Range("A:A")
If c.INTERIOR.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Sheet2").Cells(lin1, 1)
lin1 = lin1 + 1
End If
Next
End Sub
Lo único que veo es que es muy lenta que puedo hacer.
Revise la macro que me diste y le hice algunas modificaciones y quedo así:
Sub CopiarPorColorFondo()
Dim c As Range
Dim lin1 As Integer
lin1 = 1
Range("A1").Select
Selection.CurrentRegion.Select
For Each c In Range("A:A")
If c.INTERIOR.ColorIndex = 3 Then
c.EntireRow.Copy Sheets("Sheet2").Cells(lin1, 1)
lin1 = lin1 + 1
End If
Next
End Sub
Lo único que veo es que es muy lenta que puedo hacer.
1 Respuesta
Respuesta de valedor
1
Estas lineas...
Range("A1").Select
Selection.CurrentRegion.Select
No tienen caso, por que a fin de cuentas estas iterando en toda la columna A
For Each c In Range("A:A")
Por lo tanto, estas haciendo un ciclo de 1 y hasta 65536 y eso es algo lento, aunque tengas solo 10 lineas de datos por ejemplo, haces 65526 comparaciones innecesarias...
Una variente podría ser que, de la región actual, seleccionamos, solo la columna A, de este modo, si tienes 10 o 100 o 1000 lineas, SOLO estas serán las que se recorrerán y copiaran, el código quedaría así...
Sub CopiarPorColorFondo()
Dim c As Range
Dim lin1 As Integer
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns(1).Select
For Each c In Selection
If c.Interior.ColorIndex = 3 Then
lin1 = lin1 + 1
c.EntireRow.Copy Sheets("Sheet2").Cells(lin1, 1)
End If
Next
End Sub
Range("A1").Select
Selection.CurrentRegion.Select
No tienen caso, por que a fin de cuentas estas iterando en toda la columna A
For Each c In Range("A:A")
Por lo tanto, estas haciendo un ciclo de 1 y hasta 65536 y eso es algo lento, aunque tengas solo 10 lineas de datos por ejemplo, haces 65526 comparaciones innecesarias...
Una variente podría ser que, de la región actual, seleccionamos, solo la columna A, de este modo, si tienes 10 o 100 o 1000 lineas, SOLO estas serán las que se recorrerán y copiaran, el código quedaría así...
Sub CopiarPorColorFondo()
Dim c As Range
Dim lin1 As Integer
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns(1).Select
For Each c In Selection
If c.Interior.ColorIndex = 3 Then
lin1 = lin1 + 1
c.EntireRow.Copy Sheets("Sheet2").Cells(lin1, 1)
End If
Next
End Sub
