En Excel, ¿es posible contraer y mover datos de varias celdas usando una columna de referencia que tiene el mismo valor?

Question

Tengo una hoja de trabajo que tiene datos en varias filas y necesito contraer y mover esta información hacia arriba y eliminar espacios nulos usando una sola columna como punto de referencia clave.

Por ejemplo, tengo una tabla donde la columna A contiene los valores a y CB. Las columnas B, C y D también tienen datos, pero mis filas solo contienen datos para 2 columnas, dejando las otras columnas vacías. Necesito mover todos los valores de las filas hacia arriba completando los espacios en blanco si la primera columna coincide. Después de que las columnas suben, las últimas filas pueden tener datos nulos, solo necesito mover los datos hacia arriba.

Esto es lo que estoy tratando de hacer. No tengo columnas ni encabezados de fila en la lista

a  1      null      null
a  2      null      null
a null     1        null
a null     2        null    
a null    null        1
a null    null        2     
a null    null        3
B  1      null      null
B  2      null      null
B null     1        null
B null     2        null    
B null    null        1
B null    null        2     
B null    null        3
C  1      null      null
C  2      null      null
C null     1        null
C null     2        null    
C null     3        null
C null    null        1     
C null    null        2

Necesito consolidar y mover datos para lograrlo.

a  1        1      1
a  2        2      2
a null   null     3
B  1        1      1
B  2        2      2
B  null   null     3
C  1        1      1
C  2        2      2
C  null    3     null

¿Alguien puede ayudar?

Answer 1

Empezando con:

Ejecutando la macro MAIN():

Dim DidSomething As Boolean

Sub MAIN()
    DidSomething = True
    While DidSomething
        Call KompactData
    Wend
    Call RowKiller
End Sub

Sub KompactData()
    Dim N As Long, i As Long
    Dim j As Long, v As Variant

    N = Cells(Rows.Count, "A").End(xlUp).Row
    DidSomething = False

    For j = 2 To 4
        For i = 2 To N
            v = Cells(i, j).Value
            If (v <> "") And (Cells(i - 1, j) = "") And (Cells(i, 1) = Cells(i - 1, 1)) Then
                Cells(i - 1, j) = v
                Cells(i, j).ClearContents
                DidSomething = True
            End If
        Next i
    Next j
End Sub


Sub RowKiller()
    Dim N As Long, i As Long, r As Range
    N = Cells(Rows.Count, "A").End(xlUp).Row
    With Application.WorksheetFunction
        For i = N To 1 Step -1
            Set r = Range(Cells(i, 1), Cells(i, 4))
            If .CountBlank(r) = 3 Then
                r.Delete Shift:=xlUp
            End If
        Next i
    End With
End Sub

Producirá: