楼主
liuguansky |
Q:如何依代号连接进货与销售表信息，并返回进货商品的库存？
即实现依照sheet2的进货名称将sheet1的库存数据汇总成sheet3的结果。
A：用如下代码可以实现：
- Sub justtest()
- Dim D As New Dictionary, Arr, i&, j As Byte, ArrR(), K&
- '定义变量，字典对象前期绑定，需引用VBE工具下MS SCRIPTING.RUNTIME
- Arr = Sheet2.Range("A1").CurrentRegion.Value
- '获取代码与进货名称关系表数据
- On Error GoTo 100 '设置错误跳转
- For i = 2 To UBound(Arr) '循环
- D.Add Arr(i, 1), Arr(i, 2) '添加代号入字典项目，如果重复则生成错误
- Next i
- With Sheet1 '代号库存日明细写入数组，方便后续调用处理
- Arr = .Range("A5:ah" & .Cells(.Rows.Count, 1).End(3).Row).Value
- End With
- For i = 1 To UBound(Arr) Step 3 '循环库存项目
- If D.Exists(Arr(i, 1)) Then '如果代号在关系表中存在，则
- If Not D.Exists(D(Arr(i, 1))) Then '如果进货名称在结果中不存在，则
- K = K + 1: D.Add D(Arr(i, 1)), K '添加进货名称入字典项目KEY，同时对行号进行累加标识
- ReDim Preserve ArrR(1 To 33, 1 To K) '动态定义结果存放数组
- ArrR(1, K) = D(Arr(i, 1)): ArrR(2, K) = Arr(i, 3) '赋数组第一二项值
- End If
- For j = 4 To UBound(Arr, 2) '循环日记录
- If Len(Arr(i, j)) Then '如果非空
- ArrR(j - 1, D(D(Arr(i, 1)))) = ArrR(j - 1, D(D(Arr(i, 1)))) + Arr(i, j)
- '则累加对应的结果数组位置元素的数量
- End If
- Next j
- End If
- Next i
- With Sheet3
- .Range("a4:ag" & .Rows.Count).Clear '清空结果区域
- With .Range("a4").Resize(K, 33)
- .Value = Application.Transpose(ArrR) '返回结果
- .Borders.LineStyle = xlContinuous '设置边框
- End With
- End With
- Exit Sub
- 100 MsgBox "代号不惟一，请确认后重新运行程序。": End
- '对代号不惟一进行提示，并结束程序。
- End Sub
该帖已经同步到 liuguansky的微博 |