Sub csg()
Dim m(), n()
Dim a&, b&, c&, i&, lr&
With Sheets(1)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
m = Range(.[g1], .Range("A" & lr)).Value
End With
With Sheets(2)
lr = .Cells(Rows.Count, 1).End(xlUp).Row
n = Range(.[e1], .Range("A" & lr)).Value
End With
For a = 1 To UBound(m) Step 11
For b = 2 To 6 Step 2
For c = a + 3 To a + 9
For i = 2 To UBound(n)
If m(a, 1) = n(i, 1) And m(a + 2, b) = n(i, 2) And m(c, 1) = n(i, 3) Then
m(c, b) = n(i, 4)
m(c, b + 1) = n(i, 5)
End If
Next
Next
Next
m(a + 3, 2) = WorksheetFunction.Sum(m(a + 3, 2), m(a + 4, 2), m(a + 5, 2), m(a + 6, 2), m(a + 7, 2), m(a + 8, 2), m(a + 9, 2))
m(a + 3, 3) = WorksheetFunction.Sum(m(a + 3, 3), m(a + 4, 3), m(a + 5, 3), m(a + 6, 3), m(a + 7, 3), m(a + 8, 3), m(a + 9, 3))
m(a + 3, 4) = WorksheetFunction.Sum(m(a + 3, 4), m(a + 4, 4), m(a + 5, 4), m(a + 6, 4), m(a + 7, 4), m(a + 8, 4), m(a + 9, 4))
m(a + 3, 5) = WorksheetFunction.Sum(m(a + 3, 5), m(a + 4, 5), m(a + 5, 5), m(a + 6, 5), m(a + 7, 5), m(a + 8, 5), m(a + 9, 5))
m(a + 3, 6) = WorksheetFunction.Sum(m(a + 3, 6), m(a + 4, 6), m(a + 5, 6), m(a + 6, 6), m(a + 7, 6), m(a + 8, 6), m(a + 9, 6))
m(a + 3, 7) = WorksheetFunction.Sum(m(a + 3, 7), m(a + 4, 7), m(a + 5, 7), m(a + 6, 7), m(a + 7, 7), m(a + 8, 7), m(a + 9, 7))
Next
Sheets(1).[a1].Resize(UBound(m), 7) = m
Application.ScreenUpdating = True
End Sub |