基于父子层次结构的分组项目分类

Question

我有数千行带有父子层次结构的行以及我在这里分享的示例。数据具有从 0 到 10 的层次结构级别，但对我来说，级别 3 及更高级别很重要，因为我正在计算父级别 3 的权重，这取决于它的子级别和子级别。

从 L 列到 P 列，我展示了层次结构，其中 3 是父级，4 是子级，然后一些子级 4 被分类为 5、6、7……等等。父项 3 的权重是所有 4 的总和，其中 4 的总和又是 5 的总和，依此类推..

我最初尝试编写父信息。通过在 C7 中输入以下公式 =IF(B7>3;IF(B7>B6;D6;C6);"")

在第 6 行之前可以正常工作，然后由于此处的级别从 6 变为 5 而失败。请参见下图

所以我意识到 Excel 公式不足以提取所有父信息。此外，单元格 F6 再次根据材料进行分类，再次依赖于子项。

谁能告诉我如何继续使用 vba 来提取父信息。和重量分类？几行代码对我开始很有帮助。

提前非常感谢！

Answer 1

请测试下一个代码。您没有回答我的澄清问题，以下代码假定您没有向我们展示第二个5 的正确重量：

Sub CalculateWeight()
   Dim sh As Worksheet, lastR As Long, arr, arrC, ref As Long, i As Long, j As Long, k As Long

   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
   arr = sh.Range("B3:D" & lastR).Value 'put the range to be processed in an array, for faster iterations
   ReDim arrC(1 To UBound(arr), 1 To 1) 'redim the final array for the same number of rows like arr

   For i = 1 To UBound(arr)             'iterate between the array rows
        If arr(i, 1) > 3 Then           'if the hierarchy value is > 3:
            Do While (arr(i + j, 1) > 3)'loop until the next 0
                ref = i - 1             'memorize the row keeping the third hierarchy
                If arr(i + j, 1) = arr(i + j - 1, 1) + 1 Then      'if the value in column 1 is less with a unit thay precedent
                     arrC(i + j, 1) = arr(i + j - 1, 3): j = j + 1 'take the value of the precedent row, third column
                Else
                    For k = i + j To ref Step -1                   'iterate backwards
                        If arr(i + j, 1) = arr(k - 1, 1) + 1 Then  'when find the hierarchy less with a unit
                            arrC(i + j, 1) = arr(k - 1, 3): j = j + 1: Exit For 'take the value of third column and exit iteration
                        End If
                    Next k
                    
                End If
                If i + j > UBound(arr) Then Exit For  'exit iteration if it exceeds the array number of elements
            Loop
        Else
            arrC(i, 1) = ""                            'for lines before each 3
        End If
        If j > 0 Then i = i + j - 1: j = 0  'reinitialize variables
   Next i
   sh.Range("C3").Resize(UBound(arrC), 1).Value = arrC 'drop the array content at once
End Sub