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

你可能感兴趣的:(VBA字典数组运用实例(工资核算))