Sub newPivot data_for_table As Worksheet report_1 As Workbook Диапазон

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Sub newPivot(data_for_table As Worksheet, report_1 As Workbook)
' Диапазон данных
active_rows = data_for_table.Cells(1, 1).CurrentRegion.Rows.Count
active_columns = data_for_table.Cells(1, 1).CurrentRegion.Columns.Count
copy_region = "Лист1!" & Range(Cells(1, 1), Cells(active_rows, active_columns)).Address(ReferenceStyle:=xlR1C1)
' Вставка сводной таблицы
report_1.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=copy_region).CreatePivotTable TableDestination:="", TableName:="Table", DefaultVersion:=xlPivotTableVersion10
Set this_table = report_1.Sheets(1).PivotTables("Table")
' Добавление данных в сводную таблицу
With this_table.PivotFields("Компания")
.Orientation = xlRowField
.Position = 1
End With
this_table.AddDataField this_table.PivotFields("Итог"), "Сумма по полю Итог", xlSum
With this_table.PivotFields("Месяц")
.Orientation = xlColumnField
.Position = 1
.NumberFormat = "[$-419]mmmm;@"
End With
End Sub
Sub Add()
Application.DisplayAlerts = False
Set currentWB = ActiveWorkbook
Path = ActiveWorkbook.Path
Set newWB = Application.Workbooks.Add
Dim plus_row As Integer
plus_row = 0
month_count = currentWB.Sheets.Count
' Добавляем шапку таблицы в новую книгу
Set Data = newWB.Sheets(1)
Data.Cells(1, 1).Value = "Компания"
Data.Cells(1, 2).Value = "Итог"
Data.Cells(1, 3).Value = "Месяц"
' Вставка данных со всех листоа текущей книги в Лист1 новой книги
For i = 1 To currentWB.Sheets.Count
count_r = currentWB.Sheets(i).Cells(1, 1).CurrentRegion.Rows.Count
month_name = currentWB.Sheets(i).Name
For j = 2 + plus_row To count_r + plus_row
Data.Cells(j, 1) = currentWB.Sheets(i).Cells(j - plus_row, 1)
Data.Cells(j, 2) = currentWB.Sheets(i).Cells(j - plus_row, 2)
Data.Cells(j, 3) = CDate("1 " & month_name)
Data.Cells(j, 3).NumberFormat = "[$-419]mmmm;@"
Next
plus_row = count_r + plus_row - 1
Next
newWB.SaveAs (Path + "\" + "Данные")
' --------------------------------------------------------------Формирование Отчёта №1---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add
' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)
' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №1")
' --------------------------------------------------------------Формирование Отчёта №2---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add
' Список компаний и сумма заключенных с компанией договоров в процентом отношении к общей сумме
With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
.Calculation = xlPercentOfTotal
End With
' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)
' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №2")
' --------------------------------------------------------------Формирование Отчёта №3---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add
' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)
' Сумма заключенных компанией договоров к текущему месяцу за весь истекший период (с нарастающим итогом в поле )
Range("C12").Select
With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
.Calculation = xlRunningTotal
.BaseField = "Месяц"
End With
' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №3")
' --------------------------------------------------------------Формирование Отчёта №4---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add
' Сравнение всех сумм заключенных договоров с компанией "Ракушка"
With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
.Calculation = xlDifferenceFrom
.BaseItem = "Ракушка"
End With
' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)
' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №4")
End Sub