大家好，我是捌贰春秋VBA 。每天有大量的进货，怎样一目了然的查到货品的价格浮动呢？今天给大家带来对比每日进货价功能 。
查询结果
功能介绍
1、选择要比价的日期区间
2、点击“查指定品种”按钮 ， 弹出InputBox对话框，输入多个品名，中间用中文逗号隔开
3、即可罗列出该日期区间多个货品的进货价
查询方法
代码
Private Sub CommandButton2_Click()
On Error Resume Next
Dim dic1 As Object, dic2 As Object, dic3 As Object
Dim arr, brr(), i&, j&, d1 As Range, d2 As Range
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
Set dic3 = CreateObject("scripting.dictionary")
Set d1 = Range("B1")
Set d2 = Range("D1")
If d1 > d2 Then MsgBox "开始日期不能大于结束日期！", vbCritical, "错误！": Exit Sub
If Range("A3") <> "" Then Range("A3").CurrentRegion.ClearContents
'从InputBox接收数据（多个品名）
品名 = InputBox("请输入要比价的品名，多个品名中间用逗号隔开：")
If 品名 = "" Then MsgBox "品名不能为空！", vbCritical, "错误！": Exit Sub
'将数据用逗号拆分为多个品名，并写入arr数组
arr = WorksheetFunction.Transpose(Split(品名, "，"))
'循环arr数组，将品名写入字典dic2
For i = 0 To UBound(arr)
dic2(arr(i, 1)) = ""
Next i
'将进货记录写入arr数组
arr = Sheets("进货记录").Range("A1").CurrentRegion
'循环arr数组 ， 将d1至d2之间的日期作为关键字写入字典dic1
For i = 2 To UBound(arr)
If arr(i, 1) >= d1 And arr(i, 1) <= d2 Then
arr(i, 1) = Format(arr(i, 1), "yyyy/mm/dd")
dic1(arr(i, 1)) = ""
End If
Next i
'重新定义brr数组的大小
ReDim brr(1 To dic2.Count1, 1 To dic1.Count1)
brr(1, 1) = "品名"
'brr数组第一行写入日期
i = 1
For Each d In dic1.keys
i = i1
brr(1, i) = d
Next d
'brr数组第一列写入品名
i = 1
For Each d In dic2.keys
i = i1
brr(i, 1) = d
Next d
'在进货记录中，将进货日期&品名作为关键字，单价作为条目构建字典dic3
arr = Sheets("进货记录").Range("A1").CurrentRegion
For i = 2 To UBound(arr)
dic3(Format(arr(i, 1), "yyyy/mm/dd") & arr(i, 2)) = arr(i, 7)
Next i
'循环brr数组，写入字典dic3条目（即单价）
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
brr(i, j) = dic3(brr(1, j) & brr(i, 1))
Next j
Next i
Range("A3").Resize(UBound(brr), UBound(brr, 2)) = brr
Set dic1 = Nothing
Set dic2 = Nothing
Set dic3 = Nothing
【Excel VBA 对比每日进货价，随时掌握价格波动】End Sub