Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Создание сводной таблицы макросом с динамическим диапазонов
 
Добрый день.
Прошу помочь в создании кода макроса на сводную таблицу чтобы диапазон строк таблицы определялся автоматически и название файла (книги
) тоже.При создании макроса путем автозаписи получается следующий код: ("ведомость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 Сен 2018 02:49:48
 
нет решения вопроса? :(  
 
Код
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 Сен 2018 06:46:00
No crime is so great as daring to Excel. (Winston Churchill)
 
Цитата
sinks написал:
чтобы диапазон строк таблицы определялся автоматически и название файла (книги) тоже
Для создания сводной определять название книги/файла не требуется.

В строке №10 вместо:
Код
Set wsh = Worksheets("ведомость1")
можно прописать:
Код
Set wsh = ActiveSheet
либо перебирать существующие листы с помощью цикла.
No crime is so great as daring to Excel. (Winston Churchill)
 
Maruf, Большое спасибо!!! это то, что нужно))
 
Рад помочь.
No crime is so great as daring to Excel. (Winston Churchill)
 
Ребят, еще вопрос, косаемый сводной таблицы:
как в макросе прописать, чтобы он выделил ячейку столбца верхней или нижней жирной границей если значение ячейки больше или меньше 0.75 например
 
Может так:
Код
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)
 
Maruf, да, спасибо.
а как еще прописать код с подобным  выделением в диапазоне от 0,5 до 1,5 в столбике?
 
Код
If c>0.5 And c<1.5 Then....
No crime is so great as daring to Excel. (Winston Churchill)
 
Maruf, примного благодарен)
Страницы: 1
Читают тему (гостей: 1)
Наверх