Ist es in Excel möglich, Daten aus mehreren Zellen mithilfe einer Referenzspalte mit demselben Wert auszublenden und zu verschieben?

Question

Ich habe ein Arbeitsblatt mit Daten in mehreren Zeilen und muss diese Informationen reduzieren und nach oben verschieben sowie Nullzeichen entfernen, wobei ich eine einzelne Spalte als Hauptbezugspunkt verwende.

Ich habe beispielsweise eine Tabelle, in der Spalte A die Werte a und CB enthält. Die Spalten B, C und D enthalten ebenfalls Daten, aber meine Zeilen enthalten nur Daten für zwei Spalten, sodass die anderen Spalten leer bleiben. Ich muss alle Werte in den Zeilen nach oben verschieben und die Lücken füllen, wenn die erste Spalte übereinstimmt. Nachdem die Spalten nach oben verschoben wurden, können die letzten Zeilen Nulldaten enthalten, ich muss nur die Daten nach oben verschieben.

Hier ist, was ich versuche zu tun. Ich habe keine Spalten und Zeilenüberschriften aufgelistet

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

Ich muss Daten konsolidieren und verschieben, um sie

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

Kann jemand helfen?

Answer 1

Beginnen mit:

Ausführen des Makros 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

wird herstellen: