|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 lkqsmxw 于 2020-3-15 12:16 编辑
Sub 汇总数据()
Dim arr, i As Long, mRow As Long, j As Integer, k As Long, Keys, Its, m, BRR
Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
Worksheets("3月数据汇总").Range(Worksheets("3月数据汇总").Cells(4, 2), Worksheets("3月数据汇总").Cells(65536, 24)).ClearContents
With Worksheets("3月明细表")
mRow = .Range("B65536").End(3).Row
arr = .Range("B3:U" & mRow).Value
End With
Dim pName$, mNumber&, TotalCost#, mSales#, GrossProfit#, pNameB$
For i = 1 To UBound(arr)
pName = arr(i, 1) & "│" & arr(i, 4)
mNumber = Val(arr(i, 5))
TotalCost = Val(arr(i, 14))
mSales = Val(arr(i, 10)) + Val(arr(i, 11)) + Val(arr(i, 9))
GrossProfit = mSales - TotalCost
If Len(pName) And Not d.Exists(pName) Then d(pName) = Array(mNumber, TotalCost, mSales, GrossProfit) Else d(pName) = Array(mNumber + mNumber, TotalCost + TotalCost, mSales + mSales, GrossProfit + GrossProfit)
Next
With Worksheets("3月数据汇总")
.Activate
mRow = Cells.Find("*", , , , 1, 2).Row
BRR = .Range(.Cells(4, 2), .Cells(mRow, 24)).Value
Keys = d.Keys
Its = d.items
For j = 2 To UBound(BRR, 2) Step 6
pNameB = .Cells(2, j + 1)
m = 0
For i = 0 To UBound(Keys)
If pNameB = Split(Keys(i), "│")(0) Then
m = m + 1
BRR(m, j - 1) = Split(Keys(i), "│")(1)
For k = 2 To 5
BRR(m, k + j - 2) = Its(i)(k - 2)
Next
End If
Next
Next
.Range(.Cells(4, 2), .Cells(mRow, 24)).Value = BRR
End With
Set d = Nothing
End Sub
|
|