VBA字典数组运用实例（工资核算）

四月份，从软件岗位调到成本核算岗位，工作一下就忙碌起来，平时很忙，月底更忙，有时候不得不感叹命运的无奈。

我从事于一个制造代加工企业，产品更迭快，各种临时订单加塞，计划往往跟不上变化。而公司的结构又类似古代宋朝，岗位分的很细，管事儿的人多，又不专职干本职工作，各种穿插岗位，弄的工作很多，其实有大量的重复性工作，但还是必须得做。

在刚接这岗位时候交接出了点问题，先是同事突然离职，又内部轮岗，就一抹黑地只能自己摸索。

起初是做一张大表，把各种基础数据怎么方便怎么输进去，由于之前了解点数据透视表和一些函数，所以表做的尽管不太规范，但胜在方便，各种基础数据录入一遍就可以，后期还能汇总。

就像这篇文第一张图，我把成本表和工资放在一起，但看工资部分是不规范的，没办法直接用透视表，我之前的办法是把工资部分复制粘贴出去，然后规整成能透视的表，再汇总，熟练了也不耗用多少时间，最多半小时就能做完。

但时间真的很紧，如果不想加班(加班没加班费)，只能尽可能的开发自己了，怎样减少工作时间，于是接触了vba。下面是我编的代码，思路很简单，先是把生产人员和对应的工资装入数组，再用字典功能汇总。由于人名全手录，总会有点错误，还得改，用数据有效性的下拉菜单会好点，但我用的时候总会碰到点特殊情况。

万恶的月底又来了，盘点，分摊，想想都头大，目标是把成本核算一键搞定。

我是vba初学者，欢迎大家批评指正。

Sub 效益工资汇总()

Dim d As Object, arr, arr1, arr2, arr3, arr4, arrr(), rrow&, aa&, bb&, cc&, dd&, ee&, n%, n1%, n2%, n3%, m&

Set d = CreateObject("scripting.dictionary")

rrow = Worksheets("成本数据录入").[a63356].End(xlUp).Row

arr = Worksheets("成本数据录入").Range("ay2:az" & rrow)

arr1 = Worksheets("成本数据录入").Range("ba2:bb" & rrow)

arr2 = Worksheets("成本数据录入").Range("bc2:bd" & rrow)

arr3 = Worksheets("成本数据录入").Range("be2:bf" & rrow)

arr4 = Worksheets("成本数据录入").Range("bg2:bh" & rrow)

ReDim Preserve arrr(1 To UBound(arr) * 5, 1 To 2)

For aa = 1 To UBound(arr)

arrr(aa, 1) = arr(aa, 1)

arrr(aa, 2) = arr(aa, 2)

Next

For bb = UBound(arr) + 1 To UBound(arr1) * 2

n = n + 1

arrr(bb, 1) = arr1(n, 1)

arrr(bb, 2) = arr1(n, 2)

Next

For cc = UBound(arr1) * 2 + 1 To UBound(arr2) * 3

n1 = n1 + 1

arrr(cc, 1) = arr2(n1, 1)

arrr(cc, 2) = arr2(n1, 2)

Next

For dd = UBound(arr2) * 3 + 1 To UBound(arr3) * 4

n2 = n2 + 1

arrr(dd, 1) = arr3(n2, 1)

arrr(dd, 2) = arr3(n2, 2)

Next

For ee = UBound(arr3) * 4 + 1 To UBound(arr4) * 5

n3 = n3 + 1

arrr(ee, 1) = arr4(n3, 1)

arrr(ee, 2) = arr4(n3, 2)

Next

Columns("a:b").Clear

On Error Resume Next

For m = 1 To UBound(arrr)

d(arrr(m, 1)) = d(arrr(m, 1)) + arrr(m, 2)

Next

[a1:b1] = Array("生产人员", "效益工资")

Range("a2:a" & d.Count) = Application.Transpose(d.keys)

Range("b2:b" & d.Count) = Application.Transpose(d.items)

Set d = Nothing

End Sub