Sub dsd()
Dim i As Long, lr As Long, n As Long, data, col As New Collection
lr = Cells(Rows.Count, 6).End(xlUp).Row
data = Range("F2:I" & lr)
Range("A11:C1000").ClearContents
ReDim result(0, 2)
k = 11
For n = 2 To 5
If IsEmpty(Cells(n, 2)) Then GoTo EndFor
Cells(k, 2) = Cells(n, 2) & " - " & Cells(n, 3): k = k + 1
For i = LBound(data) To UBound(data)
x = DateSerial(Year(Cells(n, 2)), Month(Cells(n, 2)), 1)
x2 = DateSerial(Year(Cells(n, 3)), Month(Cells(n, 3)), Day(DateSerial(Year(Cells(n, 3)), Month(Cells(n, 3)) + 1, 1) - 1))
If x <= data(i, 1) And x2 >= data(i, 1) Then
Cells(k, 1) = data(i, 1)
If Cells(n, 2) > DateSerial(Year(data(i, 1)), Month(data(i, 1)), 1) And _
Cells(n, 3) < DateSerial(Year(Cells(n, 3)), Month(data(i, 2)), Day(DateSerial(Year(data(i, 2)), Month(data(i, 2)) + 1, 1) - 1)) Then 'нужно указать что бы дата месяц год совпадал
Cells(k, 2) = Day(Cells(n, 3)) - Day(Cells(n, 2)) + 1
ElseIf Cells(n, 2) > DateSerial(Year(data(i, 1)), Month(data(i, 1)), 1) Then
Cells(k, 2) = data(i, 2) - Day(Cells(n, 2)) + 1
ElseIf Cells(n, 3) < DateSerial(Year(Cells(n, 3)), Month(data(i, 2)), Day(DateSerial(Year(data(i, 2)), Month(data(i, 2)) + 1, 1) - 1)) Then
Cells(k, 2) = DateSerial(Year(Cells(n, 3)), Month(data(i, 2)), Day(DateSerial(Year(data(i, 2)), Month(data(i, 2)) + 1, 1) - 1)) - Cells(n, 2) + 1
Else
Cells(k, 2) = data(i, 2)
End If
Cells(k, 3) = Cells(k, 2) * data(i, 4) * Cells(n, 4)
k = k + 1
End If
Next i
EndFor:
Next n
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = 11 To lr
On Error Resume Next
If Cells(i, 1) <> "" Then col.Add Cells(i, 1), CStr(Cells(i, 1))
Next i
k = k + 1
For i = 1 To col.Count
Cells(k + i, 1) = col(i)
Cells(k + i, 2) = Cells(Range("A11:A" & lr).Find(col(i)).Row, 2)
Cells(k + i, 3) = Application.WorksheetFunction.SumIf(Range("A11:A" & lr), col(i), Range("C11:C" & lr))
Next i
End Sub
|