在日常工作中，我们经常需要从大量数据中提取特定商品的最新记录，并根据需求数量进行补齐。例如，在销售分析、库存管理或订单处理中，可能需要快速获取某商品最近N次的交易记录。今天，我将分享一个 Excel VBA 宏，它能高效实现 多商品按最近日期提取数据并向前补齐，让你的数据处理更智能、更高效！
假设你有一份销售数据表
按H2:I5,条件筛选
结果如下：
代码呈现：
Sub 多商品_最近日期_按数量_向前补齐()
Dim ws As Worksheet
Dim arr, 商品条件
Dim 商品名 As String, 需求数量 As Long
Dim i As Long, j As Long
Dim lastRow As Long
Dim 输出行 As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
商品条件 = ws.Range("H2:I5").Value
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lastRow < 2 Then
MsgBox "A:E 区域无数据"
Exit Sub
End If
arr = ws.Range("A2:E" & lastRow).Value
输出行 = 2
For j = 1 To UBound(商品条件)
商品名 = 商品条件(j, 1)
需求数量 = 商品条件(j, 2)
If 商品名 = "" Or 需求数量 <= 0 Then GoTo 下一商品
Dim tmp(), t As Long
ReDim tmp(1 To UBound(arr), 1 To 5)
t = 0
For i = 1 To UBound(arr)
If arr(i, 1) = 商品名 Then
t = t + 1
tmp(t, 1) = arr(i, 1)
tmp(t, 2) = arr(i, 2)
tmp(t, 3) = arr(i, 3)
tmp(t, 4) = arr(i, 4)
tmp(t, 5) = arr(i, 5)
End If
Next i
If t = 0 Then GoTo 下一商品
Dim total As Long: total = t
Dim a As Long, b As Long
Dim temp(1 To 5)
For a = 1 To total - 1
For b = a + 1 To total
If tmp(a, 4) < tmp(b, 4) Then
'逐列交换，避免数组赋值错误
Dim c As Long
For c = 1 To 5
temp(c) = tmp(a, c)
tmp(a, c) = tmp(b, c)
tmp(b, c) = temp(c)
Next c
End If
Next b
Next a
Dim 取数 As Long
取数 = Application.Min(total, 需求数量)
Dim result()
ReDim result(1 To 取数, 1 To 5)
For i = 1 To 取数
For c = 1 To 5
result(i, c) = tmp(i, c)
Next c
Next i
ws.Range("K" & 输出行).Resize(取数, 5).Value = result
输出行 = 输出行 + 取数
下一商品:
Next j
MsgBox "批量提取完成"
End Sub
使用方法
按 Alt + F11 打开 VBA 编辑器。
插入新模块，粘贴上述代码。
返回 Excel，按 Alt + F8，选择 多商品_最近日期_按数量_向前补齐 并运行。
查看结果
结果将自动输出到 K列及之后，并按商品分组显示。
这个 VBA 宏能高效解决 多商品按最近日期提取数据并补齐 的问题，适用于销售分析、库存管理、订单处理等场景。掌握它，让你的 Excel 操作更智能、更专业！
