如何在Excel中通过层级生成父子列（VBA或公式实现）

一、公式实现方案（优先推荐，易部署） #

1. A列（对应K列内容） #

在A3单元格输入公式，下拉填充至K列最后一行：

=K3

2. C列（子项：当前行D-I首个非空单元格） #

• Excel 365/2021及以上版本（支持XLOOKUP）：在C3输入，下拉填充：

=XLOOKUP(TRUE, D3:I3<>"", D3:I3,, 1)

• 旧版Excel：输入数组公式（按Ctrl+Shift+Enter确认后下拉）：

=INDEX(D3:I3, MATCH(TRUE, NOT(ISBLANK(D3:I3)), 0))

3. B列（父项：子项左侧列向上首个非空单元格） #

• Excel 365/2021+：在B3输入，下拉填充：

=LET(
    child_col, COLUMN(XLOOKUP(C3, D3:I3, D3:I3,, 0, 1)),
    parent_col, child_col - 1,
    XLOOKUP(TRUE, INDIRECT(ADDRESS(1, parent_col)&":"&ADDRESS(ROW()-1, parent_col))<>"", INDIRECT(ADDRESS(1, parent_col)&":"&ADDRESS(ROW()-1, parent_col)),, -1)
)

• 旧版Excel：输入数组公式（按Ctrl+Shift+Enter确认后下拉）：

=LOOKUP(2, 1/(INDIRECT(CHAR(CODE(LEFT(ADDRESS(1, MATCH(C3, D:I, 0)+3))-1)&":"&CHAR(CODE(LEFT(ADDRESS(1, MATCH(C3, D:I, 0)+3))-1))<>"")), INDIRECT(CHAR(CODE(LEFT(ADDRESS(1, MATCH(C3, D:I, 0)+3))-1)&":"&CHAR(CODE(LEFT(ADDRESS(1, MATCH(C3, D:I, 0)+3))-1))))

二、VBA脚本实现方案 #

按你设想的逻辑编写，直接运行即可：

Sub ConvertToParentChild()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim childCell As Range
    Dim parentCol As Integer
    Dim parentCell As Range
    
    ' 设置当前工作表（可根据实际修改工作表名称）
    Set ws = ThisWorkbook.ActiveSheet
    
    ' 找到K列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
    
    ' 从第3行开始循环处理
    For currentRow = 3 To lastRow
        ' 将K列内容复制到A列
        ws.Cells(currentRow, "A").Value = ws.Cells(currentRow, "K").Value
        
        ' 查找D-I列首个非空单元格（子项）
        Set childCell = ws.Range("D" & currentRow & ":I" & currentRow).Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
        If Not childCell Is Nothing Then
            ' 将子项写入C列
            ws.Cells(currentRow, "C").Value = childCell.Value
            
            ' 获取子项左侧列，向上查找首个非空单元格（父项）
            parentCol = childCell.Column - 1
            Set parentCell = ws.Cells(1, parentCol).Resize(currentRow - 1, 1).Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
            If Not parentCell Is Nothing Then
                ws.Cells(currentRow, "B").Value = parentCell.Value
            End If
        End If
    Next currentRow
End Sub

使用说明：

1. 打开Excel文件，按Alt+F11打开VBA编辑器
2. 插入新模块，粘贴上述代码
3. 回到工作表，运行该宏即可

内容的提问来源于stack exchange，提问作者CraigA