VBA Excel 从父级获取一个值给它的所有子级

Question

我想制作一个 VBA 代码，该代码将遍历项目层次结构列表并将特定值从父行部分复制到它的所有子行部分。正如您在下图中看到的，我在“J”列中有一个层次结构列表，在“C”列中有一个子组值。所以目标是获取 VBA 代码以将最上面的项目“子组”值复制到它的所有子部分。我为不同层次结构分支的块着色：1.1、1.2 和 1.3。

所以你可以看到第 1.1 行的“001”应该被复制到它的所有子部分，这些子部分总是由“.”分隔，例如，1.1.1 是 1.1 中的第一个项目，而它又是一个父部分 1 中的第一部分

我解决这个问题的方法是从整个列表的底部开始，逐个迭代向上迭代，直到我到达层次结构分支中的最上面的项目，然后取那个最上面项目的“子组”值并将其复制到同一列，但在搜索开始的第一行。

这意味着要找到项目 1.1.29 父部分，我需要排除右侧+分隔符“。”知道要寻找什么。这将是 1.1。接下来，我将重复该操作并排除字符串的右侧，分隔符为 1。正如您在示例列表中所见，没有值为 1 的 ITEM NO，这意味着之前的 1.1 是最上面的部分。

现在我从带有 1.1 的行中获取“子组”值，在本例中为“001”，并将其复制到同一列单元格中，即搜索开始的第一行，即 1.1.29 .

就像那样，我需要遍历列表中的每一行。

在示例列表中，黄色块应包含“001”，红色块应包含“002”，绿色块应包含“026”。

我现在拥有的是：

Sub Recalculate()

'Declare variables
 
Dim LastRow As Long
LastRow = Cells(Rows.Count, "E").End(xlUp).Row

'Main script

For i = 2 To LastRow
current_index = Split(Cells(i, 10).Value, ".", , vbBinaryCompare)(0)
left_column = Cells(i, 3).Value
For j = current_index To LastRow
    nestled_index = Split(Cells(j, 10).Value, ".", , vbBinaryCompare)(0)
    If current_index = nestled_index Then
        Cells(j, 3).Value = left_column
        
    End If
Next j
Next i

End Sub

哪种方法可以完成工作，但往往无法正确完成。据我了解，它不会寻找与正在搜索的值完全匹配的值。比如说，我正在寻找 2.2，但有一个项目 1.1.2 并且它将它计为匹配项，因为该字符串确实包含搜索的值。

通过在列表中向下搜索并向上搜索一级，可以获得相同的所需结果。获取子组值。

假设我从 1.1.1 开始，这意味着我需要一个 1.1 的子组值，它已经是正确的，我可以将它复制到 1.1.1 行接下来假设我们正在使用 1.1.1.1，这意味着我们需要寻找 1.1.1，它现在已经获得了正确的子组值。这在整个列表中都在继续。

有人能帮我正确编写这段代码以获得想要的结果吗？

Answer 1

这应该可以满足您的要求。它获取根据“.”拆分创建的数组的前两个元素。并根据存储的父编号检查该值，如果不匹配则成为新的父编号。

    Dim i As Long
    Dim lr As Long
    Dim subgroup As String
    Dim parent As String
    
    With Sheet1
        lr = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 2 To lr
            If i = 2 Then
                subgroup = .Cells(i, 3).Value
                parent = Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1)
            ElseIf Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1) <> parent Then
                subgroup = .Cells(i, 3).Value
                parent = Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1)
            Else
                .Cells(i, 3).Value = subgroup
            End If
        Next i
    End With

如果有可能没有“.”在 J 列的单元格中，您需要执行 instr() 来检查它。

这应该可以做到。

Sub t()
    Dim i As Long
    Dim lr As Long
    Dim subgroup As String
    Dim parent As String
    dim delrng as range
    With Sheet1
        lr = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 2 To lr
            If i = 2 Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            ElseIf Left(.Cells(i, 10), Len(parent)) <> parent Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            Else
                'If you want to delete
                if delrng is nothing then
                    set delrng = .rows(i).entirerow
                else
                    set delrng = union(delrng, .rows(i).entirerow)
                end if
                .Cells(i, 3).Value = subgroup 
            End If
        Next i
    End With
    delrng.delete
End Sub

Function getParent(cell As Range) As String
    If Not InStr(1, cell.Value, ".") Then
        getParent = cell.Value
    Else
        getParent = Split(cell, ".")(0) & "." & Split(cell.Value, ".")(1)
    End If
End Function

VBA Excel 从父级获取一个值给它的所有子级

VBA Excel get a value from parent to all it's children

excel

vba

if-statement

parent-child