Excel VBA匹配订单数据生成B&L工作表代码报错求助

工作表结构与核心需求 #

我有两个工作表：

• Order：包含4列（订单数量、sap code、csc code、产品名称），当前10行数据（后续行数会增加）
• Data：包含多列，关键列：库存日期（A列）、sap code（B列）、csc code（C列）、产品名称（E列）、Line full（I列）。Line full值为0时，该行标记为绿色，表示已订购

需要实现：

1. 创建名为B&L的新工作表
2. 从Data表提取与Order订单匹配的数据，提取数量和Order中的订单数量一致
3. 提取规则：
   • 匹配sap code（数字型唯一公共键）
   • Line full=0
   • 选择Data表中日期最早的对应行

示例：若Order中SAP code XXX订购3件、YYYY订购2件，B&L表需输出对应最早日期的匹配行各3/2次

原代码报错与问题点 #

原代码在以下行报错：

Cell.Value = 1 And Range("B").Cell.Value = Sheets("Commande").Range("B").Cell.Value

完整原代码：

Dim Worksheet As Worksheet
Dim Workbook As Workbook
Dim i As Integer
Dim Lastrow As Long
Dim Cell As Range

With Worksheets("Commande")
    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Sheets.Add.Name = "B&L"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "SAP Code"
Range("C1").Select
ActiveCell.FormulaR1C1 = "CSC Code"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Product Name"

'Here i m looking at finding what data i need to retrieve
Sheets("Order").Select
For i = 2 To Lastrow
    If Not Cells(i, 1) = 0 Then Sheets("Data").Select
'Here i want to get the data in the "Data"Ws and repeat it untill the number of rows of data i copy and past matches the number listed in the order
    Do Until Z = Sheets("Order").Cells(i, 1).Value
        For Each Cell In Range("I:I")
            If Cell.Value = 1 And Range("B").Cell.Value = Sheets("Order").Range("B").Cell.Value Then
                Range("A:C", "E:F").Copy Sheets("B/L").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next Cell
    Loop
Next

核心错误分析 #

1. 语法错误：Range("B").Cell.Value 写法完全错误，应使用Cells(Cell.Row, "B").Value获取当前行的B列值；且Sheets("Commande")是笔误，应为Sheets("Order")
2. 变量未定义：Do循环使用的Z未声明初始化，逻辑直接中断
3. 逻辑错误：需求是Line full=0，但代码判断Cell.Value=1，完全相反；未实现筛选最早日期的逻辑
4. 效率极低：遍历整列Range("I:I")会处理几十万行冗余数据
5. 依赖Select操作：频繁切换工作表、选择单元格，容易出错且效率低下

修正后的完整VBA代码 #

Sub ExtractBnLData()
    Dim wsOrder As Worksheet, wsData As Worksheet, wsBnL As Worksheet
    Dim lastRowOrder As Long, lastRowData As Long
    Dim i As Long, j As Long, pasteRow As Long
    Dim targetSAP As String, orderQty As Integer
    Dim earliestDate As Date, targetRow As Long
    
    '初始化工作表对象
    Set wsOrder = ThisWorkbook.Worksheets("Order")
    Set wsData = ThisWorkbook.Worksheets("Data")
    
    '创建或激活B&L工作表（避免重复创建报错）
    On Error Resume Next
    Set wsBnL = ThisWorkbook.Worksheets("B&L")
    If Err.Number <> 0 Then
        Set wsBnL = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsBnL.Name = "B&L"
    End If
    On Error GoTo 0
    
    '设置B&L表头
    wsBnL.Range("A1:D1").Value = Array("Date", "SAP Code", "CSC Code", "Product Name")
    pasteRow = 2 '从第二行开始粘贴数据
    
    '获取Order表最后一行
    lastRowOrder = wsOrder.Cells(wsOrder.Rows.Count, "A").End(xlUp).Row
    
    '遍历Order表的每个订单
    For i = 2 To lastRowOrder
        orderQty = wsOrder.Cells(i, 1).Value
        targetSAP = wsOrder.Cells(i, 2).Value
        
        If orderQty > 0 Then '只处理数量大于0的订单
            '查找Data表中匹配SAP且Line full=0的最早日期行
            lastRowData = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row
            earliestDate = #1/1/9999# '初始化一个极大日期
            targetRow = -1
            
            For j = 2 To lastRowData
                If wsData.Cells(j, "B").Value = targetSAP And wsData.Cells(j, "I").Value = 0 Then
                    If wsData.Cells(j, "A").Value < earliestDate Then
                        earliestDate = wsData.Cells(j, "A").Value
                        targetRow = j
                    End If
                End If
            Next j
            
            '如果找到匹配行，按订单数量复制
            If targetRow <> -1 Then
                For j = 1 To orderQty
                    wsBnL.Cells(pasteRow, "A").Value = wsData.Cells(targetRow, "A").Value
                    wsBnL.Cells(pasteRow, "B").Value = wsData.Cells(targetRow, "B").Value
                    wsBnL.Cells(pasteRow, "C").Value = wsData.Cells(targetRow, "C").Value
                    wsBnL.Cells(pasteRow, "D").Value = wsData.Cells(targetRow, "E").Value
                    pasteRow = pasteRow + 1
                Next j
            End If
        End If
    Next i
End Sub

修复后优势 #

1. 避免Select操作：直接操作工作表对象，稳定高效
2. 逻辑完全匹配需求：正确判断Line full=0，筛选最早日期的行
3. 效率优化：仅遍历Data表的有效数据行，而非整列
4. 鲁棒性提升：处理B&L表已存在的情况，只处理订单数量大于0的条目
5. 语法规范：修正所有语法错误，变量声明清晰

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