代码如下,供参考:
- Sub 数据汇总()
- Dim arr, i As Long, j As Integer, mStr As String, nStr As String
- Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
- arr = Worksheets("完工产品成本汇总表").UsedRange.Value
- For i = 2 To UBound(arr)
- If Len(arr(i, 1)) > 0 And Val(arr(i, 8)) > 0 Then
- mStr = arr(i, 1)
- If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 8)) Else d(mStr) = d(mStr) + Val(arr(i, 8))
- End If
- If Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 And Len(arr(i, 6)) > 0 And Len(arr(i, 7)) > 0 Then
- mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",材料费用," & arr(i, 3)
- If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 10)) Else d(mStr) = d(mStr) + Val(arr(i, 10))
-
- mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",人工费用," & arr(i, 3)
- If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 11)) Else d(mStr) = d(mStr) + Val(arr(i, 11))
-
- mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",费用," & arr(i, 3)
- If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 12)) Else d(mStr) = d(mStr) + Val(arr(i, 12))
-
- mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",计量," & arr(i, 3)
- If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 9)) Else d(mStr) = d(mStr) + Val(arr(i, 9))
- End If
- Next
- Application.ScreenUpdating = False
- With Worksheets("完工产品成本对比表")
- .Activate
- .Range("F3:BM1048576").ClearContents
- arr = .UsedRange.Value
- For i = 3 To UBound(arr)
- If Len(arr(i, 1)) > 0 Then
- For j = 54 To 65
- If Len(arr(2, j)) > 0 Then
- mStr = arr(2, j) & arr(i, 1)
- If d.Exists(mStr) Then arr(i, j) = d(mStr)
- End If
- Next
- End If
- If Len(arr(i, 2)) > 0 And Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 Then
- For j = 6 To 41
- If Len(arr(2, j)) > 0 Then
- If Len(arr(1, j)) = 0 Then arr(1, j) = arr(1, j - 1)
- mStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(1, j) & "," & arr(2, j)
- nStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & ",计量," & arr(2, j)
- If d.Exists(mStr) Then arr(i, j) = d(mStr) / d(nStr)
- End If
- Next
- End If
- For j = 42 To 53
- arr(i, j) = Val(arr(i, j - 12)) + Val(arr(i, j - 24)) + Val(arr(i, j - 36))
- Next
- Next
- .UsedRange.Value = arr
- End With
- Application.ScreenUpdating = True
- MsgBox "数据已统计完成!"
- End Sub
复制代码
|