Исправить дочернее умножение из его параллельной спецификации

Question

У меня есть данные от моего клиента, неправильная спецификация и не может быть исправлена ​​в данный момент, получено в Excel - там много записей.Есть простой способ исправить спецификацию?Пусть мне понадобится логика, у меня есть знания VBA.Кажется, что родители написаны хорошо, но количество ребенка не умножается на его количество родителей.На втором уровне родитель влияет на предыдущее умножение.На столбце (исправлено) корректируются значения, сделанные вручную.У меня может быть несколько уровней, начиная с 0 до 20. Как можно исправить столбец qty в Excel, чтобы он стал похожим (исправленный) столбцом?

В строке 59 parent равен qty = 1 количество дочерних элементов в порядке.Проблемы начинаются со строки 80, где parent равен qty = 3, но количество потомков не будет следовать (умножается на parent).Поэтому, когда родительский кол-во! = 1, дочерние элементы должны быть умножены.Как это можно исправить сверху вниз списка?

Level/levStr/partname       qty (corected)
1    +.1    802011          3
2    +..2   802010          1   3
2    +..2   FTH-15-01       6   18
2    +..2   PLT1M           6   18
2    +..2   604189          4   12
3    +...3  604032          1   12
3    +...3  6001-2RSL       2   24
3    +...3  604034          1   12
3    +...3  604161          1   12
3    +...3  6885-A-44-20    2   24
3    +...3  W151FL-M6-12    1   12

Answer 1

Я опубликую свой быстрый код в VBA. Это ужасный код, но работает.

Option Explicit
Dim mbResult As Integer

Dim CWS As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim clevel As Long
Dim cQuantity As Long
Dim cQuantityFix As Long
Dim ended As Boolean

Public Sub MainRun()

mbResult = MsgBox("Do you want to fix QTY BOM?", vbYesNo)
Select Case mbResult

Case vbYes

Case vbNo
    Exit Sub
Case vbCancel
    Exit Sub
End Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True

Sheets(1).Activate
Set CWS = ActiveSheet

lastRow = CWS.Cells(1, 1).End(xlDown).row
lastCol = CWS.Cells(1, Columns.Count).End(xlToLeft).Column


clevel = Application.WorksheetFunction.Match("Level", CWS.Rows(1), 0)
cQuantity = Application.WorksheetFunction.Match("Quantity", CWS.Rows(1), 0)
cQuantityFix = CWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
'cQuantityFix = Application.WorksheetFunction.Match("Fix", CWS.Rows(1), 0)

Dim parentqty As Long

Dim r As Integer
Dim oLevel As Integer
oLevel = 0
ended = False

    For r = 2 To lastRow
        If ended = False Then
            Dim currlevel As Long
            Dim nextLevel As Long
            Dim qty As Long

            currlevel = Cells(r, clevel).Value
            nextLevel = Cells(r + 1, clevel).Value
            Cells(r, cQuantityFix).Select

            If IsEmpty(Cells(r, cQuantity)) Then
                    qty = 1
                    Cells(r, cQuantityFix).Value = qty
            Else
                    qty = Cells(r, cQuantity).Value
            End If

            If nextLevel > currlevel Then
                r = iCall(r, qty, nextLevel)
            End If
                Else
            Exit For
        End If
    Next r
    MsgBox ("Job Done. Qty fix on the last column")
End Sub

Private Function iCall(ByVal row As Integer, ByVal multiplier As Integer, ByVal level As Integer) As Integer


Dim actRow As Long
Dim nextLevel As Long
Dim cQty As Long


    For actRow = row + 1 To lastRow
        If ended = False Then

            Cells(actRow, cQuantityFix).Select
                nextLevel = Cells(actRow + 1, clevel).Value
            If level = nextLevel Then
                cQty = Cells(actRow, cQuantity).Value * multiplier
                Cells(actRow, cQuantityFix).Value = cQty
            Else

                Dim oVal As Integer

                    oVal = Cells(actRow, cQuantity).Value
                    cQty = oVal * multiplier
                    Cells(actRow, cQuantityFix).Value = cQty

                If level < nextLevel Then

                    nextLevel = Cells(actRow + 1, clevel).Value
                    If nextLevel > 0 Then

                        If nextLevel > level Then
                            actRow = iCall(actRow, cQty, nextLevel)
                        Else
                            Exit Function
                        End If
                    Else
                        ended = True
                        Exit Function
                    End If
                Else
                    If nextLevel > 0 Then
                        actRow = iCall(actRow, getParentLevelMultiplier(actRow, nextLevel), nextLevel)
                        iCall = actRow
                        Exit Function
                    Else
                    ended = True
                     Exit Function
                    End If
                End If
            End If
        Else
            Exit For
        End If
    Next actRow
End Function

Private Function getParentLevelMultiplier(ByVal row As Integer, ByVal level As Integer) As Integer

Dim crrlevel As Long
Dim i As Long

    For i = row To 1 Step -1
        Cells(i, clevel).Select
        crrlevel = Cells(i, clevel).Value
        If Cells(i, clevel) = level - 1 Then
            getParentLevelMultiplier = Cells(i, cQuantityFix)
            Exit For
        End If
    Next i
End Function