|
这个代码不用复制,直接可以使用。
Sub Macro1数据汇总求和()
Dim arr, brr, crr, d1, d2, i&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion
fp = ThisWorkbook.Path & "\模板总表.xlsx"
Set wb = GetObject(fp) 'Workbooks.Open
With wb.Sheets(1)
.Range("c3:l9").ClearContents
.Range("c14:l18").ClearContents
brr = .Range("a1:l9")
crr = .Range("a12:l18")
End With
For i = 2 To UBound(arr)
s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 4)
d1(s) = d1(s) + arr(i, 3)
Next
t = d1.items
With wb
With .Sheets(1)
For i1 = 2 To UBound(brr) - 1
For j = 3 To UBound(brr, 2)
s1 = brr(1, 1) & "|" & brr(i1 + 1, 1) & "|" & brr(2, j)
If d1.exists(s1) Then
n = n + 1
.Cells(i1 + 1, j) = t(n - 1)
End If
Next
Next
m = n
For i2 = 2 To UBound(crr) - 1
For j1 = 3 To UBound(crr, 2)
s2 = crr(1, 1) & "|" & crr(i2 + 1, 1) & "|" & crr(2, j1)
If d1.exists(s2) Then
m = m + 1
.Cells(i2 + 12, j1) = t(m - 1)
End If
Next
Next
End With
.Windows(1).Visible = True
.Close 1
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
评分
-
1
查看全部评分
-
|