Macro que concatene los valores de igual criterio
*** Tengo un libro con 2 hojas, en la "hoja 1" existen una notas en la columna "C" con un ID en la Columna "A" y en la "Hoja 2" en la Columna "A" tengo el ID de cada nota; Necesito de su ayuda para que por medio de una macro, me concatene en la Celda inmediatamente a la derecha de cada ID de la "hoja 2" todas las notas con ese ID:
*** Es decir
**** Nota1: Lo que sea1; Lo que sea 2; Loque sea 3;...
**** Nota 2: Lo que sea7 ; lo que sea 8;
--- Agradezco su apoyo.
--- Adjunto el libro de ejemplo:
https://mega.nz/#!f181kBbD
---- Clave de Cifrado:
!iuzeFdgQ2eHwXf5JyopND7S7FGdgsWp5RxK_Sl2Zi-Y
1 respuesta
Te anexo la macro
Sub Concatenar_Notas()
'Por Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
'h2.Cells.ClearContents
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
nota = h1.Cells(i, "A").Value
If nota <> "" Then
Set b = h2.Columns("A").Find(nota, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, "C").Value = h2.Cells(b.Row, "C").Value & "; " & h1.Cells(i, "C").Value
Else
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A").Value = nota
h2.Cells(u, "C").Value = h1.Cells(i, "C").Value
End If
End If
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Waooo funciona chevere!! mil Gracias....
** Ah solo una cosilla: al concatenar trae un campo vació adelante,, Es posible que ignore esas celdas en blanco? el resultado queda así: ; Prueba 11; Prueba 13; Prueba 14; Prueba 16; Prueba 17; Prueba 18
Seria quitar esos (;) al inicio de cada cadena.
Gracias Dante Amor
Te anexo la macro actualizada
Sub Concatenar_Notas()
'Por Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
'h2.Cells.ClearContents
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
nota = h1.Cells(i, "A").Value
If nota <> "" Then
Set b = h2.Columns("A").Find(nota, lookat:=xlWhole)
If Not b Is Nothing Then
If h2.Cells(b.Row, "C").Value <> "" Then
h2.Cells(b.Row, "C").Value = h2.Cells(b.Row, "C").Value & "; " & h1.Cells(i, "C").Value
Else
h2.Cells(b.Row, "C").Value = h1.Cells(i, "C").Value
End If
Else
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A").Value = nota
h2.Cells(u, "C").Value = h1.Cells(i, "C").Value
End If
End If
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
