Excel VBA宏开发求助：匹配WHO与BO工作表数据并分配数量

Hey there! Let's work through fixing your VBA macro step by step. I've reviewed your requirements and the code you put together, and I'll help you resolve the issues to get the functionality working as intended.

Key Issues in Your Original Code #

Before jumping to the fixed code, let's highlight the main problems that were causing your macro to get stuck:

• Variable Declaration Issues: Multiple variables declared in a single line (e.g., Dim pNum, vNum, lr As Long) only set the last variable to Long—others default to Variant, which can cause unexpected behavior.
• Dead Loop: The outer Do Until Check = FALSE loop runs forever because Check is initialized to False and never updated.
• Unnecessary Select/Selection: These slow down your code and make it fragile; we can directly reference ranges instead.
• Flawed Find/FindNext Logic: The loop to find matching material numbers wasn't properly terminating, leading to incorrect checks.
• Incorrect Column Naming: You set AC1 to a hardcoded value instead of using the Name variable (from WHO's B1).
• Missing Total Quantity Check: You didn't verify if BO's total available quantity for a material is enough before starting allocation, leading to partial work before failing.

Fixed VBA Code #

Here's the revised macro that meets all your requirements:

Sub BO_WHO_Format()
    Dim wsWHO As Worksheet
    Dim wsBO As Worksheet
    Dim newCol As Range
    Dim lastRowWHO As Long
    Dim i As Long
    Dim matNum As Variant
    Dim reqQty As Double
    Dim totalAvailQty As Double
    Dim rngFound As Range
    Dim firstFoundAddr As String
    Dim remainingQty As Double
    Dim colName As String
    
    ' Set worksheet references (avoids Select/Selection)
    Set wsWHO = ThisWorkbook.Worksheets("WHO")
    Set wsBO = ThisWorkbook.Worksheets("BO")
    
    ' Get column name from WHO's B1
    colName = wsWHO.Range("B1").Value
    If colName = "" Then
        MsgBox "Column name in WHO!B1 cannot be empty.", vbExclamation
        Exit Sub
    End If
    
    ' Insert new column in BO (insert at column AC, adjust if needed)
    Set newCol = wsBO.Range("AC:AC")
    newCol.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    wsBO.Range("AC1").Value = colName ' Set new column header
    
    ' Get last row with data in WHO's column A
    lastRowWHO = wsWHO.Cells(wsWHO.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each material in WHO (starting from row 2)
    For i = 2 To lastRowWHO
        matNum = wsWHO.Range("A" & i).Value
        reqQty = wsWHO.Range("B" & i).Value
        
        ' Validate input values
        If IsEmpty(matNum) Or Not IsNumeric(reqQty) Or reqQty <= 0 Then
            MsgBox "Invalid data in WHO row " & i & ". Check material number or quantity.", vbExclamation
            ' Cleanup: delete new column and exit
            wsBO.Range("AC:AC").Delete Shift:=xlToLeft
            Exit Sub
        End If
        
        ' Calculate total available quantity of this material in BO
        ' Adjust column "L" to your actual quantity column in BO
        totalAvailQty = Application.WorksheetFunction.SumIf(wsBO.Columns("A"), matNum, wsBO.Columns("L"))
        If totalAvailQty = 0 Then
            MsgBox "Material number " & matNum & " not found in BO, or total available quantity is 0.", vbCritical
            wsBO.Range("AC:AC").Delete Shift:=xlToLeft
            Exit Sub
        End If
        If totalAvailQty < reqQty Then
            MsgBox "Total available quantity for material " & matNum & " in BO is less than required quantity.", vbCritical
            wsBO.Range("AC:AC").Delete Shift:=xlToLeft
            Exit Sub
        End If
        
        ' Start allocating quantity
        remainingQty = reqQty
        Set rngFound = wsBO.Columns("A").Find(What:=matNum, LookAt:=xlWhole, MatchCase:=False, SearchDirection:=xlNext)
        
        If Not rngFound Is Nothing Then
            firstFoundAddr = rngFound.Address
            Do
                ' Get available quantity in this BO row (column L, adjust offset if needed)
                Dim availQty As Double
                availQty = rngFound.Offset(0, 11).Value ' Column A to L is +11 offset
                
                If availQty <= 0 Then
                    ' Skip rows with 0 quantity
                    Set rngFound = wsBO.Columns("A").FindNext(rngFound)
                    If rngFound.Address = firstFoundAddr Then Exit Do
                    Continue Do
                End If
                
                If availQty >= remainingQty Then
                    ' Assign remaining quantity to new column (AC is +28 offset from A)
                    rngFound.Offset(0, 28).Value = remainingQty
                    remainingQty = 0
                Else
                    ' Assign full available quantity, reduce remaining
                    rngFound.Offset(0, 28).Value = availQty
                    remainingQty = remainingQty - availQty
                End If
                
                ' Move to next match
                Set rngFound = wsBO.Columns("A").FindNext(rngFound)
            Loop While Not rngFound Is Nothing And rngFound.Address <> firstFoundAddr And remainingQty > 0
        End If
    Next i
    
    MsgBox "Material allocation completed successfully!", vbInformation
End Sub

Key Improvements Explained #

• Worksheet References: We use wsWHO and wsBO to directly access worksheets without Select, making the code faster and more reliable.
• Input Validation: We check for empty material numbers or invalid quantities before proceeding.
• Total Quantity Check: Using SumIf, we first verify if BO has enough total quantity for each material—this avoids partial allocation before failing.
• Clear Allocation Logic: The Do...Loop for FindNext properly terminates when we loop back to the first found address, preventing infinite loops.
• Offset Clarity: We use explicit offsets (e.g., Offset(0,11) for column L from A) and note where you might need to adjust based on your actual BO sheet structure.
• Cleanup Handling: If any error occurs, the macro immediately deletes the new column in BO before exiting, keeping your sheet clean.

Important Notes #

• Adjust the column offsets if your BO sheet's quantity column isn't column L (currently Offset(0,11) from column A) or if the new column isn't AC (currently Offset(0,28) from column A).
• The code assumes BO's material numbers are in column A—update wsBO.Columns("A") if they're in a different column.

内容的提问来源于stack exchange，提问作者Cvetelin Stoimenov