FreeRow1 = 2
RowStart = 2
n = 3
With Sheets("ЕС")
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
For i = n To LastRow
If .Cells(i, 1) <> "" Then
DR = .Cells(i, 1)
Cells(FreeRow1, 1) = .Cells(i, 1)
End If
For ii = i To LastRow
If .Cells(ii, 1) = DR Or .Cells(ii, 1) = "" Then
If .Cells(ii, 3) > 0 Then
Set Rng = Sheets("справочник").Range("B2:C999").Find(what:=.Cells(ii, 2), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
If Rng.Column = 2 Then
Cells(FreeRowStroy, 2) = .Cells(ii, 2)
Cells(FreeRowStroy, 4) = .Cells(ii, 3)
CounterStroy = CounterStroy + 1
FreeRowStroy = FreeRowStroy + 1
Else
Cells(FreeRowMont, 5) = .Cells(ii, 2)
Cells(FreeRowMont, 7) = .Cells(ii, 3)
CounterMont = CounterMont + 1
FreeRowMont = FreeRowMont + 1
End If
End If
End If
Else
i = ii - 1
If FreeRowStroy > FreeRowMont Then
FreeRow1 = FreeRowStroy
Else
FreeRow1 = FreeRowMont
End If
Cells(FreeRow1, 2) = "Итого:" & DR
Cells(FreeRow1, 3) = CounterStroy
Cells(FreeRow1, 5) = "Итого:" & DR
Cells(FreeRow1, 6) = CounterMont
Cells(FreeRow1, 7) = "summa" <<<------------------- подскажите как суммировать нужный диапазон
CounterStroy = 0
CounterMont = 0
With Range(Cells(RowStart, 1), Cells(FreeRow1, 1))
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
End With
Range(Cells(FreeRow1, 2), Cells(FreeRow1, 7)).Interior.ColorIndex = 15
Range(Cells(RowStart, 2), Cells(FreeRow1, 7)).Borders.LineStyle = True
RowStart = FreeRow1 + 1
FreeRow1 = FreeRow1 + 1
FreeRowStroy = FreeRow1
FreeRowMont = FreeRow1
Exit For
End If
Next
If ii > LastRow Then
Cells(FreeRow1 + 1, 2) = "Итого:"
Cells(FreeRow1 + 1, 3) = CounterStroy
Cells(FreeRow1 + 1, 5) = "Итого:"
Cells(FreeRow1 + 1, 6) = CounterMont
With Range(Cells(RowStart, 1), Cells(FreeRow1 + 1, 1))
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
End With
Range(Cells(FreeRow1 + 1, 2), Cells(FreeRow1 + 1, 7)).Interior.ColorIndex = 15
Range(Cells(RowStart, 2), Cells(FreeRow1 + 1, 7)).Borders.LineStyle = True
Exit Sub
End If
Next
End With
Application.ScreenUpdating = True
End Sub
|