Option Explicit
Private fm As Worksheet
Private sh As Worksheet
Private ys As Long
Sub AddSheet()
Dim Application_Calculation As XlCalculation
Application_Calculation = Application.Calculation
Application.Calculation = xlCalculationManual
Set fm = Sheets("ФинМодель")
Set sh = Sheets.Add(After:=fm)
SheetJob "M3:AV3"
Application.Calculation = Application_Calculation
End Sub
Private Sub SheetJob(range_date As String)
sh.Columns(1).ColumnWidth = 9.14
sh.Columns(2).ColumnWidth = 8.71
sh.Columns(3).ColumnWidth = 6
sh.Columns(4).ColumnWidth = 31.71
sh.Columns(5).ColumnWidth = 11.14
sh.Columns(6).ColumnWidth = 9.71
With sh.Cells(1, 1).Resize(1, 6)
.Value = Array("Дата", "Месяц", "Год", "Показатель", "Значение", "Ед. изм.")
.Font.Bold = True
End With
Dim cl As Range
ys = 1
For Each cl In fm.Range(range_date).Cells
DateJob cl
Next
sh.UsedRange.Font.Size = 10
sh.ListObjects.Add xlSrcRange, sh.UsedRange, , xlYes
sh.ListObjects(1).TableStyle = ""
End Sub
Private Sub DateJob(clDate As Range)
Dim sf As String
sf = Replace(Replace(Cells(1, clDate.Column).Address(1, 1), 1, ""), "$", "")
AddParam clDate.Value, sf, 6, "Выручка ПИР"
AddParam clDate.Value, sf, 7, "Выручка СМР"
AddParam clDate.Value, sf, 8, "Выручка ПНР"
AddParam clDate.Value, sf, 9, "Выручка ТМЦ"
AddParam clDate.Value, sf, 11, "Расходы на фазе II Планирование"
AddParam clDate.Value, sf, 12, "Материальные Затраты"
AddParam clDate.Value, sf, 13, "Услуги подрядчиков и прочие услуги"
AddParam clDate.Value, sf, 14, "Финансовые расходы"
AddParam clDate.Value, sf, 15, "Затраты на оплату труда"
AddParam clDate.Value, sf, 16, "Резерв на гарантийное обслуживание"
End Sub
Private Sub AddParam(dt As Date, sf As String, yf As Long, param As String)
ys = ys + 1
With sh.Rows(ys)
.Cells(1, 1).Value = dt
.Cells(1, 2).Value = Format(dt, "MMMM")
With .Cells(1, 3)
.Value = dt
.NumberFormat = "yyyy"
End With
.Cells(1, 4).Value = param
With .Cells(1, 5)
.Formula = "=" & fm.Name & "!" & sf & yf
.NumberFormat = "#,##0.00"
End With
.Cells(1, 6).Formula = "=" & fm.Name & "!C" & yf
End With
End Sub
|