excel办公技巧比价(Excel VBA 对比每日进货价，随时掌握价格波动)

大家好，我是捌贰春秋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.Count 1, 1 To dic1.Count 1)

brr(1, 1) = "品名"

'brr数组第一行写入日期

i = 1

For Each d In dic1.keys

i = i 1

brr(1, i) = d

Next d

'brr数组第一列写入品名

i = 1

For Each d In dic2.keys

i = i 1

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

End Sub