Hola! CURIBER. Sigue los siguientes pasos:
a) Haz click derecho en la solapa de la hoja en la que deseas el efecto y selecciona: Ver código;
b) En la ventana que se te abrirá, copia y pega lo siguiente:
Código PHP:
Sub Concatenar()
Dim Mat1, Vec1, Mat2
Dim Rng As Range, i As Long, j As Long, TC As Long, Q As Long
On Error Resume Next
Set Rng = Application.InputBox("Selecciona el rango a procesar" & vbLf & "(por ejemplo: B2:D17)", "Resumen por concatenación", Type:=8)
If Rng Is Nothing Then Exit Sub
Mat1 = Rng
Q = UBound(Mat1, 1)
ReDim Vec1(1 To Q, 1 To 1)
ReDim Mat2(1 To Q, 1 To 2)
For i = 1 To Q
j = WorksheetFunction.Match(Mat1(i, 1), Vec1, 0)
If Err.Number > 0 Then
Err.Clear
TC = 1 + TC: j = TC
Vec1(j, 1) = Mat1(i, 1)
Mat2(j, 1) = Mat1(i, 2)
End If
Mat2(j, 2) = IIf(Mat2(j, 2) = Empty, "", Mat2(j, 2) & ";") & Mat1(i, 3)
Next i
On Error GoTo 0
With Rng.Parent.Cells(Rng(1).Row, Rng(1).Column + 10)
.Offset(, 1).Resize(100 + Q, 3).Delete
.Offset(, 1).Resize(TC) = Vec1
.Offset(, 2).Resize(TC, 2) = Mat2
.Offset(, 1).CurrentRegion.Sort Key1:=.Offset(, 1), Order1:=xlAscending, Header:=False
.Offset(, 1).Resize(Q, 3).Columns.AutoFit
Application.Goto .Offset(, -2), True
End With
End Sub
c) Cierra esa ventana del ambiente Visual Basic for Application en el que te encuentras, y retorna al Excel.
d) Ejecuta la macro recién incorporada:
Concatenar.
e) La macro te solicita que selecciones el rango de tres columnas con los datos a procesar. Al cabo de unos instantes: ¡obtendrás lo pedido!
¿Te sirve la idea?...
Saludos, Cacho R.
