No Excel, é possível recolher e mover dados de várias células usando uma coluna de referência que tenha o mesmo valor

Question

Eu tenho uma planilha que possui dados em várias linhas e precisa recolher e mover essas informações para cima e remover e anular espaços usando uma única coluna como ponto de referência da chave.

Por exemplo, eu tenho uma tabela onde a coluna A contém os valores a e CB. As colunas B, C e D também possuem dados, mas minhas linhas contêm apenas dados para duas colunas, deixando as outras colunas vazias. Eu preciso mover todos os valores nas linhas para cima, preenchendo os espaços em branco se a primeira coluna corresponder. Depois que as colunas são movidas para cima, as últimas linhas podem ter dados nulos, só preciso mover os dados para cima.

Aqui está o que estou tentando fazer. Eu não tenho colunas e cabeçalhos listados

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

Eu preciso consolidar e mover dados para torná-lo

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

Alguém pode ajudar?

    

Answer 1

Começando com:

ExecutandoamacroMAIN():

DimDidSomethingAsBooleanSubMAIN()DidSomething=TrueWhileDidSomethingCallKompactDataWendCallRowKillerEndSubSubKompactData()DimNAsLong,iAsLongDimjAsLong,vAsVariantN=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

produzirá: