首页 > 解决方案 > 我想根据excel中的某些逻辑将单个值分配给多行

问题描述

我有多个级别的分组数据(儿童-父母活动)。下面有多个父子级别。我想根据给每个孩子的某些权重为以下子活动分配一个值(例如 1,000,000 分)。添加快照以供参考。有人可以帮忙吗?

层次分组数据的快照:

[1]:https://i.stack.imgur.com/1UEG0.png

标签: excelvba

解决方案


将此代码添加到您的项目中,看看它是否有效。转到 VBA 编辑器并确保将其放入新模块中...

Public Function CalculateWeightedPoints(ByVal rngData As Range, ByVal strID As String, ByVal dblWeighting As Double) As Double
    Dim lngRow As Long, strThisID As String, strParent As String, arrParent() As String, i As Long, objCell As Range
    Dim dblParentValue As Double, lngCValueCol As Long, rngCaller As Range, lngWSRow As Long, lngWSCol As Long

    Application.Volatile

    Set rngCaller = Application.Caller
    lngValueCol = rngCaller.Column

    arrParent = Split(strID, ".")

    ' Determine the parent ID.
    For i = 0 To UBound(arrParent) - 1
        If i > 0 Then strParent = strParent & "."
        strParent = strParent & arrParent(i)
    Next

    ' Find the parent value, it will be used to weight the children.
    For lngRow = 1 To rngData.Rows.Count
        Set objCell = rngData.Cells(lngRow, 1)

        strThisID = Trim(rngData.Cells(lngRow, 1))

        lngWSRow = objCell.Row
        lngWSCol = rngCaller.Column

        If strThisID = "" Then Exit For

        If strThisID = strParent Then
            ' Get the value of the parent.
            dblParentValue = objCell.Worksheet.Cells(lngWSRow, lngWSCol)
            Exit For
        End If
    Next

    On Error Resume Next

    Err.Clear

    CalculateWeightedPoints = dblWeighting * dblParentValue

    If Err.Description <> "" Then
        CalculateWeightedPoints = 0
    End If
End Function

...然后在您的数据矩阵中,将以下公式添加到您要为其计算加权值的单元格中。一件事,确保公式从 1.1 开始,而不是第一个 WBS。第一个 WBS 需要具有原始值。

=CalculateWeightedPoints($A$1:D2,A3,C3)

...从那里填写公式,希望它对您有用。

在此处输入图像描述

只需确保需要的 ID(即 WBS)在范围的第一列中,尽管您有它,所以应该没问题。

这张图片显示了计算的值,我希望它是你所追求的。

在此处输入图像描述


推荐阅读