¿Macros para excel - Como puedo hacer lo siguiente?

Ho la Joako

Puedes poner una imagen de cómo quieres el resultado

Recomiendo:

https://youtu.be/fkMDV64YyE0 

Sal u dos

Dante Amor

Ya entendí.

Prueba la siguiente macro:

Sub codigos()
  Dim dic As Object
  Dim i As Long
  Dim a As Variant, b As Variant
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(3)).Value
  For i = 1 To UBound(a)
    dic(a(i, 2)) = dic(a(i, 2)) & a(i, 1) & ","
  Next
  For i = 1 To UBound(a)
    b = Split(dic(a(i, 2)), ",")
    Range("C" & i + 1).Resize(1, UBound(b)).Value = b
  Next
End Sub

Recomendaciones sobre diccionarios:

https://youtu.be/f_x8pstpNqc 

https://youtu.be/oAQ4e-m_m7g 

https://youtu.be/DI33KOtxcPk 

Sal u dos

Dante Amor

Le agregué un par de líneas a la macro para que sea más rápida.

Sub codigos()
  Dim dic As Object
  Dim i As Long
  Dim a As Variant, b As Variant
  Application.ScreenUpdating = False
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(3)).Value
  For i = 1 To UBound(a)
    dic(a(i, 2)) = dic(a(i, 2)) & a(i, 1) & ","
  Next
  For i = 1 To UBound(a)
    b = Split(dic(a(i, 2)), ",")
    Range("C" & i + 1).Resize(1, UBound(b)).Value = b
  Next
  Application.ScreenUpdating = True
End Sub

Recomendado!!!

Sal u dos

Dante Amor

Puedo ayudarte a crear una macro en Excel para lograr lo que necesitas. La macro tomará los códigos en la columna A y los colocará en forma horizontal en la columna C y siguientes, agrupándolos por familia.

Sub OrganizarPorFamilia()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim codesRange As Range, codeCell As Range
    Dim familyDict As Object
    Dim family As String
    ' Establecer la hoja de trabajo activa
    Set ws = ActiveSheet
    ' Obtener la última fila en la columna A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' Crear un diccionario para almacenar los códigos por familia
    Set familyDict = CreateObject("Scripting.Dictionary")
    ' Recorrer los códigos en la columna A
    Set codesRange = ws.Range("A2:A" & lastRow)
    For Each codeCell In codesRange
        ' Obtener la familia del código
        family = ws.Range("B" & codeCell.Row).Value
        ' Agregar el código al diccionario de familias
        If familyDict.exists(family) Then
            familyDict(family) = familyDict(family) & ", " & codeCell.Value
        Else
            familyDict(family) = codeCell.Value
        End If
    Next codeCell
    ' Copiar los códigos organizados por familia en forma horizontal
    Dim outputRange As Range
    Set outputRange = ws.Range("C2")
    For Each family In familyDict.keys
        outputRange.Value = familyDict(family)
        Set outputRange = outputRange.Offset(0, 1)
    Next family
    ' Limpiar el diccionario
    Set familyDict = Nothing
    ' Ajustar el ancho de las columnas para mostrar todos los códigos
    ws.Columns("C:Z").AutoFit
End Sub

La macro se ejecutará y organizará los códigos por familia en las columnas C y siguientes. Asegúrate de tener suficiente espacio en las columnas C y siguientes para acomodar todos los códigos.

Hola Rafael, antes que nada gracias por tu respuesta.

Estoy intentando ejecutar la macro y me arroja el siguiente error.

¿

Estaré haciendo algo mal?

Saludos

Parece que la variable de control del bucle "For Each" no se ha declarado correctamente. Aquí tienes el código corregido:

Sub OrganizarPorFamilia()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim codesRange As Range, codeCell As Range
    Dim familyDict As Object
    Dim family As String
    Dim outputRange As Range ' Nueva variable agregada
    ' Establecer la hoja de trabajo activa
    Set ws = ActiveSheet
    ' Obtener la última fila en la columna A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' Crear un diccionario para almacenar los códigos por familia
    Set familyDict = CreateObject("Scripting.Dictionary")
    ' Recorrer los códigos en la columna A
    Set codesRange = ws.Range("A2:A" & lastRow)
    For Each codeCell In codesRange
        ' Obtener la familia del código
        family = ws.Range("B" & codeCell.Row).Value
        ' Agregar el código al diccionario de familias
        If familyDict.exists(family) Then
            familyDict(family) = familyDict(family) & ", " & codeCell.Value
        Else
            familyDict(family) = codeCell.Value
        End If
    Next codeCell
    ' Copiar los códigos organizados por familia en forma horizontal
    ' Establecer el rango de salida en la columna C
    Set outputRange = ws.Range("C2")
    For Each family In familyDict.keys
        outputRange.Value = familyDict(family)
        Set outputRange = outputRange.Offset(0, 1)
    Next family
    ' Limpiar el diccionario
    Set familyDict = Nothing
    ' Ajustar el ancho de las columnas para mostrar todos los códigos
    ws.Columns("C:Z").AutoFit
End Sub

Porfavor danle depurar y donde sale error la linea

Hola Rafael Vera me arroja un error la macro cuando la ejecuto, te adjunto una captura para más detalles.

Igualmente te quería comentar que con la macro que me pasaron más arriba, pude resolver lo que tenia que hacer.

Te agradezco por el tiempo y por ayudarme.

Saludos!