Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание сводной таблицы макросом с динамическим диапазонов
 
#1
14.09.2018 01:54:19
Добрый день.
Прошу помочь в создании кода макроса на сводную таблицу чтобы диапазон строк таблицы определялся автоматически и название файла (книги
) тоже.При создании макроса путем автозаписи получается следующий код: ("ведомость1" и "R14C14" могут меняться при открытии новой ведомости)
Код
Sub 111()
ActiveSheet.Range("A8").CurrentRegion.Select 'выделяет всю таблицу с ячейки "A8"
      
   Sheets.Add 'создает сводную таблицу на новом листе
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "ведомость1!R8C1:R14C14", Version:=xlPivotTableVersion14). _
       CreatePivotTable TableDestination:="Лист1!R3C1", TableName:= _
       "СводнаяТаблица1", DefaultVersion:=xlPivotTableVersion14
   Sheets("Лист1").Select
   Cells(3, 1).Select
   With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("год")
       .Orientation = xlColumnField
       .Position = 1
   End With
   With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("месяц")
       .Orientation = xlColumnField
       .Position = 2
   End With
   With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("валюта2")
       .Orientation = xlRowField
       .Position = 1
   End With
   With ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("% СТАВКА НА ДАТУ " _
       )
       .Orientation = xlRowField
       .Position = 2
   End With
   ActiveSheet.PivotTables("СводнаяТаблица1").AddDataField ActiveSheet.PivotTables _
       ("СводнаяТаблица1").PivotFields("ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)"), _
       "Сумма по полю ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)", xlSum
   ActiveWindow.Zoom = 80 'именьшает ZOOM сводной таблицы до 80%
End Sub
Изменено: sinks - 18.09.2018 02:49:48
 
 
 
#2
18.09.2018 02:50:48
нет решения вопроса? :(  
 
 
 
#3
18.09.2018 06:45:52
Код
Sub pt_creator()
Dim wsh As Worksheet
Dim new_wsh As New Worksheet
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim prange As Range


' определяем источник и адрес назначения
Set wsh = Worksheets("ведомость1")
Set prange = wsh.Cells(8, 1).CurrentRegion
Set new_wsh = Sheets.Add

Set ptCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=prange)
Set pt = ptCache.CreatePivotTable(TableDestination:=new_wsh.Cells(3, 1), TableName:="СводнаяТаблица2")

'придаём сводной таблице стандартный вид
pt.InGridDropZones = False
pt.TableStyle2 = "PivotStyleLight16"

'устанавливаем столбцы и строки сводной таблицы
With pt.PivotFields("год")
    .Orientation = xlColumnField
    .Position = 1
End With
With pt.PivotFields("месяц")
    .Orientation = xlColumnField
    .Position = 2
End With
With pt.PivotFields("валюта2")
    .Orientation = xlRowField
    .Position = 1
End With
With pt.PivotFields("% СТАВКА НА ДАТУ ")
    .Orientation = xlRowField
    .Position = 2
End With


pt.AddDataField pt.PivotFields("ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)"), _
    "Сумма по полю ОСТАТОК НА ДАТУ (ЭКВИВАЛЕНТ.)", xlSum
ActiveWindow.Zoom = 80 'именьшает ZOOM сводной таблицы до 80%

End Sub
Изменено: Maruf - 18.09.2018 06:46:00
No crime is so great as daring to Excel. (Winston Churchill)
 
 
 
#4
18.09.2018 06:58:06
Цитата
sinks написал:
чтобы диапазон строк таблицы определялся автоматически и название файла (книги) тоже
Для создания сводной определять название книги/файла не требуется.

В строке №10 вместо:
Код
Set wsh = Worksheets("ведомость1")
можно прописать:
Код
Set wsh = ActiveSheet
либо перебирать существующие листы с помощью цикла.
No crime is so great as daring to Excel. (Winston Churchill)
 
 
 
#5
18.09.2018 08:48:11
Maruf, Большое спасибо!!! это то, что нужно))
 
 
 
#6
18.09.2018 14:49:52
Рад помочь.
No crime is so great as daring to Excel. (Winston Churchill)
 
 
 
#7
19.09.2018 04:19:01
Ребят, еще вопрос, косаемый сводной таблицы:
как в макросе прописать, чтобы он выделил ячейку столбца верхней или нижней жирной границей если значение ячейки больше или меньше 0.75 например
 
 
 
#8
19.09.2018 06:17:35
Может так:
Код
Dim c
Dim pt_table As Range

Set pt_table = pt.TableRange1.Offset(3, 0).Resize(pt.TableRange1.Rows.Count - 3, pt.TableRange1.Columns.Count)
pt_table.Select
For Each c In pt_table.Columns(11).Cells
    If c > 0.75 Then
        With c.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Color = -11489280
            .TintAndShade = 0
            .Weight = xlThick
        End With
    End If
Next




No crime is so great as daring to Excel. (Winston Churchill)
 
 
 
#9
19.09.2018 07:46:37
Maruf, да, спасибо.
а как еще прописать код с подобным  выделением в диапазоне от 0,5 до 1,5 в столбике?
 
 
 
#10
19.09.2018 07:58:55
Код
If c>0.5 And c<1.5 Then....
No crime is so great as daring to Excel. (Winston Churchill)
 
 
 
#11
19.09.2018 08:26:40
Maruf, примного благодарен)
 
 
 
#12
19.12.2018 10:57:34
Maruf большое спасибо!!! Воспользовался вашим кодом макроса для создания сводной таблицы с динамическим диапазоном. Очень помогло, облазил весь интернет !!!
 
 
 
Страницы: 1
Наверх