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 SingleMsgBox "汇总计算时间较久，请耐心待"
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).ValueSheets("系数").Visible = xlSheetVeryHiddenSheets("机加任务及工时").Selectrowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
ActiveSheet.Range("N1") = "JE"
'计算加工费用,第1行有标题，从第2行开始
For i = 2 To rowscountFor j = 1 To UBound(brr)If ActiveSheet.Range("K" & i) = brr(j, 1) ThenActiveSheet.Range("N" & i) = ActiveSheet.Range("M" & i) * brr(j, 2)End IfNext
NextReDim arr_s(1 To rowscount, 1 To 2)
For i = 2 To rowscountarr_s(i, 1) = ActiveSheet.Range("A" & i).Valuearr_s(i, 2) = ActiveSheet.Range("N" & i).Value
NextDim 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).RowReDim crr(1 To rowscount, 1 To 2)
For i = 2 To rowscount '第一行有标题，从第二行开始crr(i, 1) = ActiveSheet.Cells(i, 1).Valuecrr(i, 2) = ActiveSheet.Cells(i, 3).Value
Next'外协费用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheets("材料&外协金额表").Select
rowscount = ActiveSheet.Cells(Rows.count, 1).End(xlUp).RowReDim drr(1 To rowscount, 1 To 2)
For i = 2 To rowscount '第一行有标题，从第二行开始drr(i, 1) = ActiveSheet.Cells(i, 1).Valuedrr(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).RowFor i = 2 To rowscountFor j = 0 To d.count - 1 '字典KEY从0开始If ActiveSheet.Cells(i, 1) = d.keys()(j) ThenActiveSheet.Cells(i, 11) = d.items()(j)End IfNext 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)
NextFor i = 1 To d2.countActiveSheet.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)
NextFor i = 1 To d3.countActiveSheet.Cells(i, 16) = d3(drr(i, 1))
NextActiveSheet.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 = TrueSheets("目录").Select
End Sub