Estimados Amigos,

 

Buenas tardes, tengo una pregunta sobre como podría optimizar una macro que recorre 300.000 registros y concatena información con el siguiente código:

 

Sub ConcatenaColumnas()
Dim numzeros As String
numzeros = "0000000000"

Range("A:B").Select
Selection.NumberFormat = "@"

Range("E3").Select

'------------------Columna Validación--------------------------------------------------------------------------------------------
   Do While ActiveCell <> ""  'Bucle hasta la celda este en blanco

''de la celda activada retroceder xx números (0, -xx) a la izquierda y escribir fórmula
      ActiveCell.Offset(0, -4).FormulaR1C1 = _
         Format(ActiveCell.Offset(0, 0), "dd") & Format(ActiveCell.Offset(0, 0), "mm") & Format(ActiveCell.Offset(0, 0), "yyyy") _
         & Left(numzeros, 10 - Len(ActiveCell.Offset(0, 3))) & ActiveCell.Offset(0, 3) _
         & Left(numzeros, 10 - Len(ActiveCell.Offset(0, 4))) & ActiveCell.Offset(0, 4) _
         & ActiveCell.Offset(0, 5) _
         & ActiveCell.Offset(0, 6)
         
    ActiveCell.Offset(0, -3).FormulaR1C1 = _
            ActiveCell.Offset(0, 2) _
            & ActiveCell.Offset(0, 6) _

    ActiveCell.Offset(1, 0).Select
   Loop

End Sub

El código recorre la celda del rango "e3" validando que tenga información y concatena creando una cadena de texto en el rango (a1), sin embargo ha tardado 12 minutos en cumplir la tarea.

Alguien podría darme una mano para poder optimizar el código, sin recurrir a power bi o pivot?

 

De antemano muchas gracias.

Hola

Envía al menos algunos de los registros para darnos idea de qué es lo que tienes ahí y cómo necesitas que quede.

Abraham Valencia

Hace 49 minutos , avalencia dijo:

Hola

Envía al menos algunos de los registros para darnos idea de qué es lo que tienes ahí y cómo necesitas que quede.

Abraham Valencia

Hola Amigo,

Muchas gracias por tu respuesta, el archivo es el siguiente:

 

libroadcccc.xlsm

Hace 4 horas, Luis Antonio Torres dijo:

optimizar una macro que recorre 300.000 registros y concatena

soy fanático de los "no bucles" (cuando se puede) y esta pudiera ser una alternativa viable (?)

Sub FasterJoin()
  With Range("a3:a" & Cells(Rows.Count, 5).End(xlUp).Row)
    .Formula = "=""'""&text(e3,""ddmm"")&year(e3)&right(""0000000000""&h3,10)&right(""0000000000""&i3,10)&j3&k3"
    .Offset(, 1).Formula = "=g3&k3"
    With .Resize(, 2): .Value = .Value: End With
  End With
End Sub

 

Hace 14 horas, Héctor Miguel dijo:

soy fanático de los "no bucles" (cuando se puede) y esta pudiera ser una alternativa viable (?)

Sub FasterJoin()
  With Range("a3:a" & Cells(Rows.Count, 5).End(xlUp).Row)
    .Formula = "=""'""&text(e3,""ddmm"")&year(e3)&right(""0000000000""&h3,10)&right(""0000000000""&i3,10)&j3&k3"
    .Offset(, 1).Formula = "=g3&k3"
    With .Resize(, 2): .Value = .Value: End With
  End With
End Sub

 

Muchas gracias por la respuesta, la probaré.