Excel 2021中Level为4时提取对应Knot的公式/VBA方案问询

一、公式法（Excel 2021适用） #

直接公式写法 #

无需新增辅助列，直接在结果列（比如D列）输入以下公式，下拉填充即可：

=IF(C@=4, TEXTJOIN(",", TRUE, 
    B@,
    IFERROR(LOOKUP(2,1/(C$1:C@=3),B$1:B@),""),
    IFERROR(LOOKUP(2,1/(C$1:C@=2),B$1:B@),""),
    TEXTJOIN(",", TRUE, IF((C$1:C@=0)+(C$1:C@=1), B$1:B@, ""))
), "")

公式说明：

• IF(C@=4, ..., "")：仅当当前行Level为4时执行拼接，否则返回空值
• B@：提取当前行的Knot值
• LOOKUP(2,1/(C$1:C@=3),B$1:B@)：查找当前行上方最后一个Level=3的Knot值，IFERROR处理无匹配的情况
• LOOKUP(2,1/(C$1:C@=2),B$1:B@)：同理，查找当前行上方最后一个Level=2的Knot值
• 最后一个TEXTJOIN：筛选当前行上方所有Level=0或1的Knot值，用逗号拼接

辅助列优化写法 #

如果觉得直接公式逻辑复杂，可新增辅助列简化：

1. 新增列（比如E列），在E2输入公式并下拉：

   =IF(OR(C2=0,C2=1), B2, "")
   

   该列仅保留Level=0和1的Knot值，其他行留空
2. 结果列（D列）输入公式：

   =IF(C@=4, TEXTJOIN(",", TRUE, 
       B@,
       IFERROR(LOOKUP(2,1/(C$1:C@=3),B$1:B@),""),
       IFERROR(LOOKUP(2,1/(C$1:C@=2),B$1:B@),""),
       TEXTJOIN(",", TRUE, E$1:E@)
   ), "")
   

   逻辑更清晰，便于调试

二、VBA自定义函数法 #

若公式法灵活性不足，可通过VBA自定义函数实现：

1. 按Alt+F11打开VBA编辑器
2. 插入新模块：右键左侧工程窗口→插入→模块
3. 粘贴以下代码：

Function GetKnots(levelCell As Range) As String
    Dim ws As Worksheet
    Dim currentRow As Long
    Dim i As Long
    Dim result As String
    
    Set ws = levelCell.Worksheet
    currentRow = levelCell.Row
    
    ' 仅处理Level=4的行
    If ws.Cells(currentRow, "C").Value <> 4 Then
        GetKnots = ""
        Exit Function
    End If
    
    ' 添加当前行的Knot
    result = ws.Cells(currentRow, "B").Value
    
    ' 查找最近的Level=3的Knot
    For i = currentRow - 1 To 1 Step -1
        If ws.Cells(i, "C").Value = 3 Then
            result = result & "," & ws.Cells(i, "B").Value
            Exit For
        End If
    Next i
    
    ' 查找最近的Level=2的Knot
    For i = currentRow - 1 To 1 Step -1
        If ws.Cells(i, "C").Value = 2 Then
            result = result & "," & ws.Cells(i, "B").Value
            Exit For
        End If
    Next i
    
    ' 收集所有Level=0/1的Knot（跳过Level4/3/2）
    For i = currentRow - 1 To 1 Step -1
        Select Case ws.Cells(i, "C").Value
            Case 0, 1
                result = result & "," & ws.Cells(i, "B").Value
        End Select
    Next i
    
    ' 清理多余的连续逗号
    result = Replace(result, ",,", ",")
    ' 清理首尾可能存在的逗号
    If Left(result, 1) = "," Then result = Mid(result, 2)
    If Right(result, 1) = "," Then result = Left(result, Len(result) - 1)
    
    GetKnots = result
End Function

4. 返回Excel，在结果列（比如D9）输入：

   =GetKnots(C9)
   

   下拉填充即可应用到所有行

VBA函数说明：

• 自动跳过非Level=4的行，返回空值
• 按规则顺序拼接：当前Knot→最近Level3→最近Level2→所有上方Level0/1的Knot
• 自动清理拼接过程中可能出现的多余逗号

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