在 Excel 中,是否可以使用具有相同值的參考列來折疊和移動多個儲存格中的數據

在 Excel 中,是否可以使用具有相同值的參考列來折疊和移動多個儲存格中的數據

我有一個工作表,其中包含多行數據,需要折疊並向上移動這些信息,並使用單列作為關鍵參考點來刪除和空空格。

例如,我有一個表,其中 A 列包含值 a 和 CB。 B、C 和 D 列也有數據,但我的行僅包含 2 列的數據,其他列為空。如果第一列匹配,我需要將行中的所有值向上移動以填充空白。將它們的列向上移動後,最後一行可以有空數據,我只需要向上移動數據。

這就是我正在嘗試做的事情。我沒有列出列和行標題

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

我需要整合和行動數據才能實現

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

有人可以幫忙嗎?

答案1

從...開始:

在此輸入影像描述

運行巨集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

將產生:

在此輸入影像描述

相關內容