Question

我从客户那里得到的数据是错误的BOM，暂时无法修复，在Excel中收到-那里有很多记录。有简单的方法可以修复BOM吗？可能有我需要的一些逻辑帮助，我有一些VBA知识。似乎父母的书写还可以，但是孩子的父母的数量没有乘以。在第二级，父级受先前乘法的影响。在列上（已更正）已校正的值是手工制作的。我可以有多个级别，从0到20 如何将Excel中的数量列更正为（更正）列？

在第59行，父母的数量= 1个孩子的数量可以。问题从第80行开始，其中parent为qty = 3，但child的qty不跟随（乘以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

从其当前BOM Excel中修复子乘法

1 个答案: