arrays - Agregar, clasificar y transponer filas en columnas

excel excel-vba

Question

Tengo la siguiente tabla

 Id     Letter
1001    A
1001    H
1001    H
1001    H

1001    B
1001    H
1001    H
1001    H

1001    H
1001    H
1001    H

1001    A
1001    H
1001    H
1001    H
1001    B

1001    A
1001    H
1001    H
1001    H
1001    B

1001    B
1001    H
1001    H
1001    H
1001    B

1001    H

1001    A
1001    G
1001    H
1001    H
1001    A
1001    B

1002    B
1002    H
1002    H
1002    B

1002    G
1002    H

1002    B
1002    G
1002    G
1002    H

1002    B
1002    G
1002    H
1002    H

1002    G
1002    H
1002    H

1002    H
1002    H
1002    H
1002    M
1002    N

1002    G
1002    H
1002    H
1002    M
1002    M

1002    A
1002    H
1002    H
1002    H
1002    A
1002    B

1002    B
1002    H
1002    H
1002    H

1002    B
1002    H
1002    H
1002    H
1002    A
1002    A

1002    A
1002    H
1002    H
1002    H
1002    H
1002    B

1002    H

1003    G
1003    H
1003    H
1003    N
1003    M

Y estoy tratando de transponerlo para que cada ID diferente en la primera columna y todas las letras en la segunda columna con un espacio en blanco para cada fila en blanco en la tabla original:

1001 AHHH BHHH HHH AHHHB AHHHB BHHHB H AGHHAB
1002 BHHB GH BGGH BGHH GHH HHHMN GHHMM AHHHAB BHHH BHHHAA AHHHHB H
1003 GHHNM

Tengo alrededor de 100 ID diferentes. Traté de hacer con una fórmula usando TRANSPOSE y TRIM. También probé con una macro y VLOOKUP parece ser la forma más fácil, pero no puedo descubrir cómo

Answer 1

Esta opción incorpora matrices. Desde el punto de vista del rendimiento, es mucho más rápido leer una vez los datos de la hoja de trabajo en una matriz, realizar sus procedimientos directamente en VBE y escribir los resultados en las hojas de trabajo en comparación con los procedimientos en la hoja de trabajo celda por celda.

Sub transposing()
Const sDestination As String = "D2"
Dim ar1() As Variant
Dim ar2() As Variant
Dim i As Long ''counter

ar1 = ActiveSheet.Range("A2:B" & ActiveSheet.UsedRange.Rows.Count).Value
ReDim ar2(1 To 1, 1 To 2)
ar2(1, 1) = ar1(1, 1): ar2(1, 2) = ar1(1, 2)
For i = 2 To UBound(ar1, 1)
    If ar1(i, 1) = ar2(UBound(ar2, 1), 1) Then
        ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & ar1(i, 2)
    ElseIf ar1(i, 1) = vbNullString Then
        ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & " "
    Else
        ar2 = Application.Transpose(ar2)
        ReDim Preserve ar2(1 To 2, 1 To UBound(ar2, 2) + 1)
        ar2 = Application.Transpose(ar2)
        ar2(UBound(ar2, 1), 1) = ar1(i, 1)
        ar2(UBound(ar2, 1), 2) = ar2(UBound(ar2, 1), 2) & ar1(i, 2)
    End If
Next
ActiveSheet.Range(sDestination).Resize(UBound(ar2, 1), UBound(ar2, 2)).Value = ar2

End Sub

El resultado se verá así:

La línea Const sDestination As String = "D2" indica el comienzo de la salida. Cámbielo a la celda que desee.

Answer 2

No puede concatenar un rango de celdas (también conocido como Letras ) utilizando funciones de hoja de cálculo nativas sin conocer el alcance de antemano. Como su colección de cadenas en grupos tiene números aleatorios de elementos, un enfoque de bucle VBA parece la mejor (si no la única) forma de abordar el problema. El bucle puede hacer determinaciones en el camino en que una función de hoja de trabajo es simplemente incapaz de realizar.

Toque Alt + F11 y cuando se abra el Editor de Visual Basic (también conocido como VBE), use inmediatamente los menús desplegables para Insertar ► Módulo ( Alt + I , M ). Pegue uno o ambos de los siguientes en el nuevo panel titulado algo así como Libro1 - Módulo1 (Código) .

Para concatenar los grupos de cadenas delimitados por un espacio:

Sub concatenate_and_transpose_to_delim_string()
    Dim rw As Long, lr As Long, pid As Long, str As String
    Dim bPutInColumns As Boolean

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        pid = .Cells(2, 1).Value
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                str = str & Chr(32)
                If pid <> .Cells(rw + 1, 1).Value Then
                    .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
                    .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
                End If
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
        .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
    End With
End Sub

Para dividir los grupos de cadenas en columnas:

Sub concatenate_and_transpose_into_columns()
    Dim rw As Long, lr As Long, nr As Long, pid As Long, str As String

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
                str = vbNullString
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                nr = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row
                .Cells(nr, 4) = pid
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
    End With
End Sub

Toque Alt + Q para volver a su hoja de trabajo. Con sus datos de muestra en la hoja de trabajo activa comenzando con Id en A1, toque Alt + F8 para abrir el cuadro de diálogo Macros y Ejecutar la macro.

Resultados de concatenate_and_transpose_to_delim_string:

Resultados de concatenate_and_transpose_into_columns:

Los resultados se escribirán en las celdas comenzando en D2. Probablemente sea mejor si no hubiera nada importante allí de antemano que pudiera sobrescribirse.

Apéndice:

Originalmente interpreté mal su solicitud y dividí los grupos de cadenas en columnas separadas. Lo rectifiqué con una rutina complementaria que sigue más de cerca su descripción de los requisitos, pero mantuvo ambas variaciones para que otros las consulten.

Answer 3

Para tareas como esta, Microsoft agregó "Obtener y transformar" a Excel 2016. Para usar esta funcionalidad en versiones anteriores, debe usar el complemento Power Query. El código M es muy corto:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    FillIdDown = Table.FillDown(Source,{"Id"}),
    ReplaceNull = Table.ReplaceValue(FillIdDown,null," ",Replacer.ReplaceValue,{"Letter"}),
    Transform = Table.Group(ReplaceNull, {"Id"}, {{"Count", each Text.Combine(_[Letter])}})
in
    Transform

Sus datos deben estar en "Tabla1". https://www.dropbox.com/s/bnvchofmpvd048v/SO_AggregateCollateAndTransposeColsIntoRows.xlsx?dl=0