vba - 需要帮助总结单位重量和多层次零件 list

这就是我要使用当前代码执行的操作

这是我的excel https://drive.google.com/file/d/0B1GLuBx-ROnhRExUM2xVbG1WOTQ/edit?usp=sharing

循环检查零件层是否表示它是父装配体（该层低于下一个零件）。然后，将其下的所有子零件/部件的单位重量求和（子零件下面没有其他零件）。我没有太多的编程经验，所以我不确定为什么它不起作用或者它是否是最佳方法。

Sub UpdateUnitWeight()
Const StartRow = 2
Dim oRng As Range ' Range to work on
Dim oRngSP As Range ' Range for SumProduct
Dim lRows As Long ' Counter
' Start from row "StartRow"
Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
'Set oRng = ThisWorkbook.Worksheets("Sheet1").Range("A3")
' Loop on numeric cells from StartRow
Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
    lRows = 0 ' Extra Rows belonging to current level
    ' find how many rows while value on row beneath greater than current
    Set oRngSP = oRng.Offset(lRows + 1, 0)
    Do While oRng.Value < oRngSP.Value And IsNumeric(oRngSP)
        lRows = lRows + 1
        Set oRngSP = oRngSP.Offset(1, 0)
    Loop
    Set oRngSP = Nothing
    ' Setup the range for SumProduct
    With Range(oRng, oRng.Offset(lRows, 0)).Offset(0, 2) ' Qty column
        If oRng.Value = oRngSP.Value - 1 Then
            oRng.Offset(0, 5).Formula = "=sumproduct(" & Replace(.Address, "$", "") & "," & Replace(.Offset(0, 1).Address, "$", "") & ")"
            oRng.Offset(0, 5).Interior.ColorIndex = 15
        End If
    End With
    Debug.Print oRng.Offset(0, 5).Address & vbTab & oRng.Offset(0, 5).Formula
    ' Move the range to next row
    Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing

结束子

最佳答案

据我了解，您希望有一列存储高于当前级别的SumProduct。由于样本中存在第1级的单位重量（第5行）。

Sub UpdateUnitWeight()
    Const StartRow = 2
    Dim oRng As Range ' Range to work on
    Dim oRngSP As Range ' Range for SumProduct
    Dim lRows As Long ' Counter
    ' Start from row "StartRow"
    Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
    ' Loop on numeric cells from StartRow
    Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
        lRows = 0 ' Extra Rows belonging to current level
        ' find how many rows while value on row beneath greater than current
        Set oRngSP = oRng.Offset(lRows + 1, 0)
        Do While oRng.Value < oRngSP.Value And IsNumeric(oRngSP)
            lRows = lRows + 1
            Set oRngSP = oRngSP.Offset(1, 0)
        Loop
        Set oRngSP = Nothing
        ' Setup the range for SumProduct
        With Range(oRng, oRng.Offset(lRows, 0)).Offset(0, 2) ' Qty column
            oRng.Offset(0, 5).Formula = "=sumproduct(" & Replace(.Address, "$", "") & "," & Replace(.Offset(0, 1).Address, "$", "") & ")"
        End With
        Debug.Print oRng.Offset(0, 5).Address & vbTab & oRng.Offset(0, 5).Formula
        ' Move the range to next row
        Set oRng = oRng.Offset(1, 0)
    Loop
    Set oRng = Nothing
End Sub

根据您的输出示例：



“ UpdateUnitWeight”列上的公式：

$F$2    =SUMPRODUCT(C2:C4,D2:D4)
$F$3    =SUMPRODUCT(C3,D3)
$F$4    =SUMPRODUCT(C4,D4)
$F$5    =SUMPRODUCT(C5,D5)
$F$6    =SUMPRODUCT(C6:C7,D6:D7)
$F$7    =SUMPRODUCT(C7,D7)
$F$8    =SUMPRODUCT(C8:C11,D8:D11)
$F$9    =SUMPRODUCT(C9,D9)
$F$10   =SUMPRODUCT(C10:C11,D10:D11)
$F$11   =SUMPRODUCT(C11,D11)

如果这不是正确的逻辑，您是说如果下面有更高的水平，您将乘积相加直到该水平下降？

解

现在目标很明确，该方法与上述方法略有不同。还建议您将宏存储在模块中，而不是在该工作表对象上。

Sub UpdateUnitWeight() ' Solution
    Const StartRow = 2
    Dim oRng As Range ' Range to work on
    Dim oRngTmp As Range ' Temporary Range for checking
    Dim sTxt As String ' Temporary string for formula use

    ' Start from row "StartRow"
    Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
    ' Process all numeric cells from StartRow
    Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
        ' Total Weight = Qty * Unit Weight (Level independent, applies to each row)
        oRng.Offset(0, 4).FormulaR1C1 = "=rc[-2]*rc[-1]"
        ' Unit Weight may depend on levels beneath
        ' Current level should SUM rows below that equals (current level + 1) until same level is met
        sTxt = ""
        Set oRngTmp = oRng.Offset(lRows + 1, 0)
        Do While Not IsEmpty(oRngTmp) And IsNumeric(oRngTmp)
            Select Case oRngTmp.Value - oRng.Value
                Case 1  ' if test range equals current level + 1, prepare formula (Sum of Total Weight of child)
                    sTxt = sTxt & "+" & Replace(oRngTmp.Offset(0, 4).Address, "$", "")
                Case 0
                    Exit Do
            End Select
            Set oRngTmp = oRngTmp.Offset(1, 0)
        Loop
        Set oRngTmp = Nothing
        ' Write the formula into the Unit Weight
        If Len(sTxt) > 0 Then oRng.Offset(0, 3).Formula = "=" & sTxt
        ' Move the range to next row
        Set oRng = oRng.Offset(1, 0)
    Loop
    Set oRng = Nothing
End Sub

样本输出：

关于vba - 需要帮助总结单位重量和多层次零件 list ，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/23328522/