VBA：零件成本统计之四（汇总计算）

第四步，最后进行汇总计算

'''''汇总统计的计算
Sub count()
Dim rng As Range
Dim i As Long, j As Long
Dim arr_s, arr, brr, crr, drr
Dim rowscount As Long
Dim X As Variant
Dim rg As Single, xb As Single, zj As Single


MsgBox "汇总计算时间较久，请耐心待"
Application.ScreenUpdating = False  '关闭屏幕更新，加快程序运行
Application.DisplayAlerts = False   '不显示警告信息



''计算工序费用，因为有重复，先计算，再汇总

''先获取工序的单价系数
Sheets("系数").Visible = xlSheetVisible
Sheets("系数").Select
rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row

'工时记录，1工序号2系数
ReDim brr(1 To rowscount, 1 To 2)
For i = 2 To rowscount '第一行有标题，从第二行开始
  brr(i, 1) = ActiveSheet.Cells(i, 1).Value '代码
  brr(i, 2) = ActiveSheet.Cells(i, 3).Value '系数
Next
rg = ActiveSheet.Cells(1, 6).Value
xb = ActiveSheet.Cells(2, 6).Value
zj = ActiveSheet.Cells(3, 6).Value

Sheets("系数").Visible = xlSheetVeryHidden

Sheets("机加任务及工时").Select

rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
ActiveSheet.Range("N1") = "JE"
'计算加工费用,第1行有标题，从第2行开始
For i = 2 To rowscount
  For j = 1 To UBound(brr)
  If ActiveSheet.Range("K" & i) = brr(j, 1) Then
     ActiveSheet.Range("N" & i) = ActiveSheet.Range("M" & i) * brr(j, 2)
  End If
  Next
Next



ReDim arr_s(1 To rowscount, 1 To 2)
For i = 2 To rowscount
  arr_s(i, 1) = ActiveSheet.Range("A" & i).Value
  arr_s(i, 2) = ActiveSheet.Range("N" & i).Value
Next



Dim d As Object  '定义字典变量
Set d = CreateObject("Scripting.Dictionary")   '申明1个字典变量
For i = 1 To UBound(arr_s)
    d(arr_s(i, 1)) = d(arr_s(i, 1)) + arr_s(i, 2)  '利用字典key不能重复的特点，把key相同的je相加，作为该key的item
Next
'''''''''''''''验证
'   Range("P2").Resize(d.count, 1) = WorksheetFunction.Transpose(d.keys)
'   Range("Q2").Resize(d.count, 1) = WorksheetFunction.Transpose(d.items)
'''''''''''''''



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'材料费
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("材料&外协金额表").Select
rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row

ReDim crr(1 To rowscount, 1 To 2)
For i = 2 To rowscount '第一行有标题，从第二行开始
  crr(i, 1) = ActiveSheet.Cells(i, 1).Value
  crr(i, 2) = ActiveSheet.Cells(i, 3).Value
Next

'外协费用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("材料&外协金额表").Select
rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row

ReDim drr(1 To rowscount, 1 To 2)
For i = 2 To rowscount '第一行有标题，从第二行开始
  drr(i, 1) = ActiveSheet.Cells(i, 1).Value
  drr(i, 2) = ActiveSheet.Cells(i, 4).Value
Next






'加工费汇总
Sheets("汇总统计").Select
Set d1 = CreateObject("Scripting.dictionary")
Set d2 = CreateObject("Scripting.dictionary")
Set d3 = CreateObject("Scripting.dictionary")
Set d4 = CreateObject("Scripting.dictionary")
Set d5 = CreateObject("Scripting.dictionary")
Set d6 = CreateObject("Scripting.dictionary")
rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row


For i = 2 To rowscount
  For j = 0 To d.count - 1 '字典KEY从0开始
  If ActiveSheet.Cells(i, 1) = d.keys()(j) Then
     ActiveSheet.Cells(i, 11) = d.items()(j)
  End If
  Next j
ActiveSheet.Cells(i, 12) = Round(ActiveSheet.Cells(i, 11) * rg, 2)
ActiveSheet.Cells(i, 13) = Round(ActiveSheet.Cells(i, 11) * xb, 2)
ActiveSheet.Cells(i, 14) = Round(ActiveSheet.Cells(i, 11) * zj, 2)

  
Next i

 



'材料费
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For i = 1 To UBound(crr)
 d2(crr(i, 1)) = d2(crr(i, 1)) + crr(i, 2)
Next

For i = 1 To d2.count
     ActiveSheet.Cells(i, 15) = d2(crr(i, 1))
Next



'外协费用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For i = 1 To UBound(drr)
 d3(drr(i, 1)) = d3(drr(i, 1)) + drr(i, 2)
Next

For i = 1 To d3.count
     ActiveSheet.Cells(i, 16) = d3(drr(i, 1))
Next


ActiveSheet.Cells(1, 11) = "工序加工费"
ActiveSheet.Cells(1, 12) = "人工加工费"
ActiveSheet.Cells(1, 13) = "设备折旧费"
ActiveSheet.Cells(1, 14) = "厂房折旧费"
ActiveSheet.Cells(1, 15) = "材料费用"
ActiveSheet.Cells(1, 16) = "外协费用"

moformat.format
Application.ScreenUpdating = True
Application.DisplayAlerts = True

 Sheets("目录").Select
End Sub

结果如下

另外，还有一个系数表

最后想说，其实还是有点遗憾的，一是个人水平有限，二是小公司嘛，对于信息化的投入还是欠缺的，不然按其实可以一键汇总统计出来的，特别是分摊，由于无法批量获取零件的重量，所以无法将一些成本费用进行分摊，这个要由财务通过另外的标准和方法进行操作。