Hi
may be..
Code:Sub kTest() Dim r As Long Dim c As Long Dim i As Long, j As Long Dim ka, k(), p r = Range("e" & Rows.Count).End(3).Row c = 12 ka = Range("e3:f" & r) ReDim k(1 To UBound(ka, 1), 1 To 1) For i = 1 To UBound(ka, 1) Step c j = i For r = i To i + c - 1 Step c \ 3 With Application p = Evaluate("row(" & j & ":" & Application.Min(UBound(ka, 1), j + c - 1) & ")") k(r, 1) = .Sum(.Index(ka, p, 1)) k(r + 1, 1) = .Sum(.Index(ka, p, 2)) * -1 k(r + 2, 1) = k(r, 1) / k(r + 1, 1) End With j = j + 1 Next Next Range("q3").Resize(UBound(k, 1)) = k End Sub




Reply With Quote
Bookmarks