Actualizar macro que concatena datos de rango.
Sub concatenar_permutaciones()
Dim a As Variant
Dim i As Long, j As Long, k As Long, m As Long, n As Long
a = Range("A10:AD" & Range("A" & Rows.Count).End(3).Row).Value 'CELDA INICIAL Y FINAL A CONCATENAR
ReDim b(1 To UBound(a, 1), 1 To 1000)
For i = 1 To UBound(a, 1)
n = 1
For j = 1 To 10
If a(i, j) = "" Then Exit For
For k = 11 To 20
If a(i, k) = "" Then Exit For
For m = 21 To 30
If a(i, m) = "" Then Exit For
b(i, n) = a(i, j) & a(i, k) & a(i, m)
n = n + 1
Next m
Next k
Next j
Next i
Range("AF10").Resize(UBound(b, 1), UBound(b, 2)).Value = b 'CELDA DONDE EMPIEZA A PEGAR
End SubBuena tarde. La anterior macro es una que anteriormente en otra pregunta un experto me había proporcionado la cual funciona bien para lo que la necesitaba en el momento. en la primer imagen coloco el resultado que daba la macro escrita anteriormente. La cual concatenaba los valores de los 3 rangos uniéndolos y creando las posibles combinaciones y pegándolas en el rango a partir de la columna "AF", la macro funciona de manera que arroja todos los datos de la columna. Osea si los rangos están desde la fila 10 hasta la fila 2000, la macro se ejecuta automáticamente en todos los rangos.
Ahora necesito actualizar o modificar para que solo arroje los resultados de la fila donde se encuentre activa, como el ejemplo a continuación en la siguiente imagen:
Como pueden ver, la fila activa es la 16, entonces que solo se ejecute y arroje los resultados de la fila 16 y no se ejecute en las demás filas como hacia anteriormente. También indico que por favor si la celda activa es alguna columna de la fila 16, siga estando activa sin moverse de celda,, solo arrojar el resultado y ya,,
Muchísimas gracias y espero ser claro en mi necesidad,, muchísimas gracias por el aporte y quedo atento a cualquier requerimiento,.
1 respuesta
Te anexo la macro
Sub concatenar_permutaciones_una()
'Por Dante Amor
Dim a As Variant
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim fila As Long
fila = ActiveCell.Row
a = Range("A" & fila & ":AD" & fila).Value
ReDim b(1 To 1, 1 To 1000)
i = 1
n = 1
For j = 1 To 10
If a(i, j) = "" Then Exit For
For k = 11 To 20
If a(i, k) = "" Then Exit For
For m = 21 To 30
If a(i, m) = "" Then Exit For
b(i, n) = a(i, j) & a(i, k) & a(i, m)
n = n + 1
Next m
Next k
Next j
Range("AE" & fila).Resize(1, UBound(b, 2)).Value = b
End Sub[No olvides valorar.
