VBA案例:用字典实现多条件查询、并匹配多项字段—将进仓登记表的信息匹配到盘点表
发布于 2021-10-12 06:07
具体代码如下：
Private Sub CommandButton2_Click()Application.ScreenUpdating = FalseActiveSheet.Range("c3:al318").ClearContentsDim i&, arr, dic As Dictionary, dic2 As Dictionary, dic3 As Dictionary,c&, r&, s$, c1&s = UCase(InputBox("请输入当前区域，例如A、B,大小写皆可"))Set dic = CreateObject("scripting.dictionary")Set dic2 = CreateObject("scripting.dictionary")Set dic3 = CreateObject("scripting.dictionary")With Worksheets("出入仓登记")arr = .Range("a2").CurrentRegionFor i = 3 To UBound(arr, 1)If .Cells(i, 7) <> "" Thendic(arr(i, 6)) = arr(i, 10) '以此查询"短单号"dic2(arr(i, 6)) = arr(i, 8) '以此查询"备注"dic3(arr(i, 6)) = arr(i, 9) '以此查询"数量"End IfNextEnd WithWith ActiveSheetFor r = 3 To 317For c = 3 To 37If Cells(r, 2) = "单号" Then.Cells(r, c) = dic(s & "区" & .Cells(r, 1).Value & .Cells(2, c).Value)ElseIf Cells(r, 2) = "备注" Then.Cells(r, c) = dic2(s & "区" & .Cells(r, 1).Value & .Cells(2, c).Value)ElseIf Cells(r, 2) = "数量" Then.Cells(r, c) = dic3(s & "区" & .Cells(r, 1).Value & .Cells(2, c).Value).Cells(r, 38) = Application.WorksheetFunction.Sum(Range(Cells(r, 3), Cells(r, 37)))End IfNextNext.Range("a1") = s & "区"End WithApplication.ScreenUpdating = TrueEnd Sub
小编贴心话：
在上图，工作簿中的”出入仓登记“表用于登记成品进仓信息，登记内容含订单号（位于J列）、产品款式（位于H列）、进仓数量（位于I列）。此表中的F列为位置信息，如”A区1架下层1“（表示该货物放在A区的第一排货架的下层的第一个位置），每一行位置号都是唯一的。
工作表”盘点表“显示仓库各位置的产品单号、款式、数量信息等，用于月末盘点。此表A1单元格为区号（如”F区”），第一列为货架号及所在层（如”1架下层”），第二列为所需项目（单号、款式、数量），第二行为位置号。
为方便在月末实地盘点，现需从”出入仓登记“表中根据位置信息查找产品单号、款式、数量信息，并将查询结果匹配到”盘点表“中的对应位置的对应项目栏。
代码首先清除了”盘点表“中C3:AL318的数据，然后创建了3个字典分别用以存储”出入仓登记“表中的各位置对应的”单号“、”备注”、“数量”信息。之后代码遍历“盘点表”，连接区号、货架号及所在层、所需项目作为关键字，分别在dic、dic2、dic3中查找各关键字所对应的“单号”值、“备注”值、“数量”值，放到盘点表中特定的位置。
创建字典之前需要找到VBE编程界面的“工具”菜单栏下拉列表中的”引用“项，如下图所示，勾选Microsoft scripting runtime。
创建字典dic2的过程：将“出入仓登记”表中的A2单元格的周围区域放入数组存储，遍历数组arr对应区域的第3行至最后一行(ubound(arr,1)此时相当于此表最后一行行号)，逐一联系关键字arr(i,6)以及对应的值arr(i,8)即可创建字典dic2（即F列的位置信息可以唯一匹配一个对应的H列信息）。同理可创建其他字典。
祝各位小伙伴们一天好心情，感谢您的阅读！
本文来自网络或网友投稿，如有侵犯您的权益，请发邮件至：aisoutu@outlook.com 我们将第一时间删除。
相关素材