Concatenar con una macro en dos filas
Todo Expertos! Tengo datos en dos columnas donde en la primer columna se repiten números y en la segunda repartida en todas esas filas texto así:
A B
1 lunes
1 rojo
1 7765
1 barco
2 martes
2 azul
2 jamas
Lo que quisiera es una macro que concatene la información de la siguiente manera en dos columnas A (los números) y B (texto)
1 lunes rojo 7765 barco
2 martes azul jamas
La información esta ordenada sin embargo tiene 5000 filas
2 Respuestas
Aquí tienes un ejemplo de macro en VBA que puede ayudarte a concatenar los datos de la manera que deseas:
Sub ConcatenarDatos()
Dim lastRow As Long
Dim currentNum As Variant
Dim concatText As String
' Encuentra la última fila en la columna A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Inicializa las variables
currentNum = Cells(1, 1).Value
concatText = Cells(1, 2).Value
' Recorre las filas para concatenar los datos
For i = 2 To lastRow
If Cells(i, 1).Value = currentNum Then
' Concatena el texto si el número es igual al número actual
concatText = concatText & " " & Cells(i, 2).Value
Else
' Escribe los resultados en las columnas A y B
Cells(i - 1, 3).Value = currentNum
Cells(i - 1, 4).Value = concatText
' Actualiza el número y el texto para la siguiente iteración
currentNum = Cells(i, 1).Value
concatText = Cells(i, 2).Value
End If
Next i
' Escribe los resultados para la última combinación de número y texto
Cells(lastRow - 1, 3).Value = currentNum
Cells(lastRow - 1, 4).Value = concatText
' Elimina las columnas originales
Range("A:B").Delete Shift:=xlToLeft
End Sub
Esto me llevó a la solución que necesitaba:
Sub CONCATENAR_DUPLICADOS_EN_CELDA()
Sheets("RESULTADO").Cells.Clear
'Declaramos las variables
Dim i As Integer, j As Integer
Dim finRes As Integer, finDat As Integer
Dim sCadena As String, Lista As Range, Unicos As Range
'Borramos datos en hoja RESULTADO
finDat = Application.CountA(Sheets("DATOS").Range("A:A"))
If finDat > 0 Then Sheets("RESULTADO").Range("A1:B" & finDat).Clear
'Pasamos registros únicos de nombres a la columna A de hoja RESULTADO
Set Lista = Sheets("DATOS").Range("A1:A" & finDat)
Set Unicos = Sheets("RESULTADO").Range("A1:A" & finDat)
Lista.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Unicos, Unique:=1
'Indicamos título y negrita para encabezado segunda columna
With Sheets("RESULTADO")
.Cells(1, 2) = "TEXTO"
.Cells(1, 2).Font.Bold = True
End With
'Iniciamos loop por cada registro único
finRes = Application.CountA(Sheets("RESULTADO").Range("A:A"))
With Sheets("DATOS")
For i = 2 To finRes
'Vaciamos la variable sCadena en cada loop
sCadena = vbNullString
'Iniciamos un segundo loop buscando coincidencia de nombre con la hoja datos
'Si existe componemos un string en variable scadena con los datos que deseamos
For j = 2 To finDat
If Sheets("RESULTADO").Cells(i, 1) = .Cells(j, 1) Then sCadena = sCadena & " " & .Cells(j, 2) & " " & .Cells(j, 3)
Next j
'Pasamos los datos de la variable a la hoja RESULTADO
Sheets("RESULTADO").Range("B" & i) = Trim(Mid((sCadena), 2, Len(sCadena)))
Next i
End With
'Mostramos datos y liberamos variables
Sheets("RESULTADO").Select
Set Lista = Nothing
Set Unicos = Nothing
End Sub
Encontré la solución en concatenar-informacion-de-varios-registros-duplicados-en-una-celda/
Una solución sin macros en http://www.expertosenexcelpc.com/2012/10/combinar-datos-de-filas-duplicadas-en.html