基于指定名称与目标求和值返回对应序列号的Excel宏开发需求

嘿，我明白你要的功能了——就是要从已排序的表格里，根据指定名称和目标数量，找出刚好凑够数量的那些行的序列号，对吧？先把需求再明确下，避免理解偏差：

• 现有三列已升序排列的数据：
  • A列：序列号（serial number）
  • B列：名称（names）
  • C列：数量（quantities）
• 触发条件：在单元格L2输入目标名称，M2输入需求数量（比如540）
• 宏要完成的操作：
  1. 在B列查找所有匹配L2的名称行
  2. 从这些行的C列数值开始累加，直到累加和刚好等于M2的数值
  3. 将累加范围内对应的所有A列序列号复制到N列

接下来直接上可运行的VBA代码，我已经帮你适配了升序排列的场景：

Sub GetMatchingSerialNumbers()
    Dim ws As Worksheet
    Dim targetName As String
    Dim targetQty As Double
    Dim currentRow As Long
    Dim lastRow As Long
    Dim runningTotal As Double
    Dim outputRow As Long
    
    ' 设置当前工作表（可根据实际修改表名，比如Sheet1）
    Set ws = ThisWorkbook.ActiveSheet
    
    ' 获取输入的目标名称和数量
    targetName = ws.Range("L2").Value
    targetQty = ws.Range("M2").Value
    
    ' 检查输入是否有效
    If targetName = "" Or targetQty <= 0 Then
        MsgBox "请在L2输入有效名称，M2输入正数数量！", vbExclamation
        Exit Sub
    End If
    
    ' 初始化变量
    runningTotal = 0
    outputRow = 2 ' N列从第2行开始输出（适配表头在第1行的情况）
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 清空N列旧数据（保留表头）
    ws.Range("N2:N" & ws.Cells(ws.Rows.Count, "N").End(xlUp).Row).ClearContents
    
    ' 遍历B列查找匹配名称并累加数量
    For currentRow = 2 To lastRow ' 假设数据从第2行开始，表头在第1行
        If ws.Range("B" & currentRow).Value = targetName Then
            ' 累加当前数量
            runningTotal = runningTotal + ws.Range("C" & currentRow).Value
            
            ' 将当前序列号复制到N列
            ws.Range("N" & outputRow).Value = ws.Range("A" & currentRow).Value
            outputRow = outputRow + 1
            
            ' 检查累加和是否达标
            If runningTotal >= targetQty Then
                ' 如果超过目标值，移除最后一条记录（因数据升序，最后一条是最大的）
                If runningTotal > targetQty Then
                    ws.Range("N" & outputRow - 1).ClearContents
                    outputRow = outputRow - 1
                End If
                Exit For
            End If
        End If
    Next currentRow
    
    ' 反馈结果
    If runningTotal = targetQty Then
        MsgBox "已找到匹配的序列号，共" & outputRow - 2 & "条，已输出到N列！", vbInformation
    Else
        MsgBox "无法凑出刚好等于目标数量的组合，请检查输入或数据！", vbExclamation
    End If
End Sub

代码使用说明： #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击左侧的工作簿名称，选择「插入」→「模块」
3. 将上面的代码粘贴到模块窗口中
4. 返回Excel，按下Alt + F8，选择GetMatchingSerialNumbers运行宏

注意事项： #

• 假设你的数据表头在第1行，数据从第2行开始；如果表头位置不同，修改代码里For currentRow = 2 To lastRow的起始值即可
• 因为数据是升序排列的，代码会从第一个匹配的名称开始累加，保证用最靠前的行凑够目标数量
• 如果累加过程中超过目标值，代码会自动移除最后一条记录，确保最终累加和完全匹配需求

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