условие при создании PIVOT (сводной таблицы) - Microsoft Office Excel

RoDaMa · 28.05.2020, 14:34

День добрый

есть файл с данными, в котором методом сводной таблицы на новым листе выводим данные
я его сделал макросом, чтобы постоянно не сидет и не указывать вводные данные.
Но, нужно постоянно следить при выводе из БД чтобы столбцы всегда стояли по порядку макроса, и это моя проблема

название строки постоянно на 3 стороке,
теперь вопрос: как сделат так чтобы сводная таблица создавался так:

при создании сводной таблицы
если столбец имеет название EUTCels Id
то сделай так, и встав в 1 столбец
если столбец имеет название earTcndl
то сделай так, и встав в 2 столбец
и так далее

Код:

For Each RowsP In ?Values? 'не знаю как указат значение ячеек
 If InStr(1, "\EUtCels Id\earTcndl\RTC connection success rate, %\", "\" & sh.Values & "\", vbTextCompare) = 0 Then 'что писать?
'здесь должень пристроиться код pivota?
    Next RowsP

пример файло во вложении, только расширение сделайте XLSM

Elixi · 28.05.2020, 20:49

Код:

Sub WhatNow()
'   Íĺ çíŕţ ďîí˙ë ëč ˙ âŕń ďđŕâčëüíî, _
    ďîďđîáóéňĺ ń âŕřčěč äŕííűěč íŕ Ëčńňĺ "Main", _
    ( ëó÷řĺ âńĺăî ďî řŕăŕě - "F8" )
'    Не знаю понял ли я бас правильно, _
    попробуйте с вашими данными на Листе "Main", _
    ( лучше всего по шагам - "F8" )     
Sheets("Main").Select
For CL = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
    'Debug.Print Cells(3, CL).Value
    If Len(Cells(3, CL).Value) > 0 Then
        Select Case Cells(3, CL).Value
            
            Case Is = "RTC connection success rate, %"
                MsgBox "Case Is = RTC connection success rate, %" & vbCrLf & _
                "Column = " & CL & vbCrLf & _
                "CL.Name = " & Cells(3, CL).Value & vbCrLf & _
                "What now?"
            
            Case Is = "EUtCels Id"
                MsgBox "Case Is = EUtCels Id" & vbCrLf & _
                "Column = " & CL & vbCrLf & _
                "CL.Name = " & Cells(3, CL).Value & vbCrLf & _
                "What now?"
            
            Case Is = "Date"
                MsgBox "Case Is = Date" & vbCrLf & _
                "Column = " & CL & vbCrLf & _
                "CL.Name = " & Cells(3, CL).Value & vbCrLf & _
                "What now?"
            
            Case Else
                MsgBox "Case Else" & vbCrLf & _
                "Column = " & CL & vbCrLf & _
                "CL.Name = " & Cells(3, CL).Value & vbCrLf & _
                "What can I do?"
            
            End Select
    End If
Next
End Sub

Elixi · 28.05.2020, 20:52

... поправлено выше ...

RoDaMa · 29.05.2020, 06:15

Доброе утро

мне необходимо чтобы при создании сводной таблицы и обработка данных было по условию
если значение ячейки= EUtCels Id, то

Код:

   With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields("EUtCels Id")
                      .Orientation = xlRowField
                      .Position = 1
              End With

если значение ячейки= earTcndl, то

Код:

 ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("earTcndl"), "Сумма по полю earTcndl", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю earTcndl")
        .Caption = "Среднее по полю earTcndl"
        .Function = xlAverage
    End With

и так далее все стобцы....

Это полный код

Код:

' Week_Pivot Макрос
'
Dim wsX As Worksheet

  Application.DisplayAlerts = False
  For Each wsX In Worksheets
  If wsX.Name <> "Main" Then wsX.Delete
    Next wsX

' Pivot Макрос
'добавление листа pivot
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Weekpivot"
'Мониторды айыру
    Application.ScreenUpdating = False
'
    Sheets("Weekpivot").Select
    Range("D3").Select
'
    'Sheets.Add
'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:="СводнаяТаблица4", _
        DefaultVersion:=xlPivotTableVersion14
    Sheets("Weekpivot").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields("EUtCels Id")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("earTcndl"), "Сумма по полю earTcndl", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю earTcndl")
        .Caption = "Среднее по полю earTcndl"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("RTC connection success rate, %"), _
        "Сумма по полю RTC connection success rate, %", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю RTC connection success rate, %")
        .Caption = "Среднее по полю RTC connection success rate, %"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("ERAB setup success rate, %"), _
        "Сумма по полю ERAB setup success rate, %", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю ERAB setup success rate, %")
        .Caption = "Среднее по полю ERAB setup success rate, %"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("DL Avg PRB Usage (%)"), _
        "Сумма по полю DL Avg PRB Usage (%)", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю DL Avg PRB Usage (%)")
        .Caption = "Среднее по полю DL Avg PRB Usage (%)"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("MSST, %"), "Сумма по полю MSST, %", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю MSST, %")
        .Caption = "Среднее по полю MSST, %"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("Cels av"), "Сумма по полю Cels av", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю Cels av")
        .Caption = "Среднее по полю Cels av"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("DL trac, MB"), "Сумма по полю DL trac, MB", _
        xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю DL trac, MB")
        .Caption = "Минимум по полю DL trac, MB"
        .Function = xlMin
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("DL user thrt, Mbps"), _
        "Сумма по полю DL user thrt, Mbps", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю DL user thrt, Mbps")
        .Caption = "Среднее по полю DL user thrt, Mbps"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
        ("СводнаяТаблица4").PivotFields("Act Users"), "Сумма по полю Act Users", xlSum
    With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
        "Сумма по полю Act Users")
        .Caption = "Среднее по полю Act Users"
        .Function = xlAverage
    End With
End Sub

Elixi · 29.05.2020, 14:43

Цитата:

Сообщение от RoDaMa

мне необходимо чтобы при создании сводной таблицы и обработка данных было по условию
если значение ячейки= EUtCels Id, то

Код:

   With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields("EUtCels Id")
                      .Orientation = xlRowField
                      .Position = 1
              End With

Не знаю, прoбoвали вы кoд в сooбщении #2 ?
Рoзoбрались с тем как рабoтает ?

Case Is = "EUtCels Id" там есть, вместo MsgBox "..." вставляйте ваш кoд.

Таким же oбразoм сделайте свoи Case Is = "значение ячейки кoтoрые вам требуются"
и за ним вставте кoд чтo вам надo сделать.

RoDaMa · 29.05.2020, 22:03

ругаеться что выбор case не правильный

Код:

'Dim CL As String'- обявлят переменную CL?
Sheets("Main").Select
For CL = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
    Debug.Print Cells(3, CL).Value
    If Len(Cells(3, CL).Value) > 0 Then
        Select Case Cells(3, CL).Value
    
    
    Sheets("Weekpivot").Select 'ругаеться на эту строку что первый селект не Case
    Range("D3").Select
'
    
'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:="СводнаяТаблица4", _
        DefaultVersion:=xlPivotTableVersion14
    Sheets("Weekpivot").Select
    Cells(3, 1).Select
    
    Case Is = "EUtCels Id"
                With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields("EUtCels Id")
                 .Orientation = xlRowField
                .Position = 1
                End With
    Case Is = "earTcndl"
                 ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                 ("СводнаяТаблица4").PivotFields("earTcndl"), "Сумма по полю earTcndl", xlSum
                 With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                   "Сумма по полю earTcndl")
                  .Caption = "Среднее по полю earTcndl"
                   .Function = xlAverage
                 End With
    Case Is = "RTC connection success rate, %"
                ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
             ("СводнаяТаблица4").PivotFields("RTC connection success rate, %"), _
                "Сумма по полю RTC connection success rate, %", xlSum
             With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю RTC connection success rate, %")
                   .Caption = "Среднее по полю RTC connection success rate, %"
                  .Function = xlAverage
                End With
    Case Is = "ERAB setup success rate, %"
                ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                 ("СводнаяТаблица4").PivotFields("ERAB setup success rate, %"), _
                 "Сумма по полю ERAB setup success rate, %", xlSum
               With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю ERAB setup success rate, %")
                 .Caption = "Среднее по полю ERAB setup success rate, %"
                 .Function = xlAverage
               End With
      Case Is = "DL Avg PRB Usage (%)"
                 ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                 ("СводнаяТаблица4").PivotFields("DL Avg PRB Usage (%)"), _
                 "Сумма по полю DL Avg PRB Usage (%)", xlSum
                With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю DL Avg PRB Usage (%)")
                 .Caption = "Среднее по полю DL Avg PRB Usage (%)"
                 .Function = xlAverage
                End With
      Case Is = "MSST, %"
                ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                ("СводнаяТаблица4").PivotFields("MSST, %"), "Сумма по полю MSST, %", xlSum
                With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю MSST, %")
                 .Caption = "Среднее по полю MSST, %"
                 .Function = xlAverage
                End With
      Case Is = "Cels av"
                ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                 ("СводнаяТаблица4").PivotFields("Cels av"), "Сумма по полю Cels av", xlSum
                With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю Cels av")
                 .Caption = "Среднее по полю Cels av"
                 .Function = xlAverage
                End With
      Case Is = "DL trac, MB"
                  ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                 ("СводнаяТаблица4").PivotFields("DL trac, MB"), "Сумма по полю DL trac, MB", _
                  xlSum
                With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                 "Сумма по полю DL trac, MB")
                 .Caption = "Минимум по полю DL trac, MB"
                 .Function = xlMin
                End With
      Case Is = "DL user thrt, Mbps"
                  ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                  ("СводнаяТаблица4").PivotFields("DL user thrt, Mbps"), _
                  "Сумма по полю DL user thrt, Mbps", xlSum
                 With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                  "Сумма по полю DL user thrt, Mbps")
                  .Caption = "Среднее по полю DL user thrt, Mbps"
                  .Function = xlAverage
                 End With
      Case Is = "Act Users"
                   ActiveSheet.PivotTables("СводнаяТаблица4").AddDataField ActiveSheet.PivotTables _
                  ("СводнаяТаблица4").PivotFields("Act Users"), "Сумма по полю Act Users", xlSum
                 With ActiveSheet.PivotTables("СводнаяТаблица4").PivotFields( _
                  "Сумма по полю Act Users")
                  .Caption = "Среднее по полю Act Users"
                  .Function = xlAverage
                 End With
    
      End Select
    End If
End Sub

Elixi · 29.05.2020, 22:39

попробуйте, если это будет ругаться,
это то же самое что у вас в файле,
только немножко переработанное

Код:

Sub Pivot_01()
Application.ScreenUpdating = False
For Each Sh In Worksheets
    Select Case Sh.Name
        Case Is = "Main"     ', "Weekpivot_A" 
        Case Else
            Application.DisplayAlerts = False
            Sh.Delete
            Application.DisplayAlerts = True
    End Select
Next Sh
'Stop

'добавление листа pivot
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Weekpivot"

    PvTab = "СводнаяТаблица4"

'вставляем PivotTable & первое поле PivotFields("EUtCels Id")

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _
        DefaultVersion:=xlPivotTableVersion14
        With ActiveSheet.PivotTables(PvTab).PivotFields("EUtCels Id")
            .Orientation = xlRowField
            .Position = 1
        End With

'Все остальные поля будут вставляться по порядку названий на строке 3 в Листе Main

For CL = 1 To Sheets("Main").Cells(3, Columns.Count).End(xlToLeft).Column
    'Debug.Print Cells(3, CL).Value
    If Len(Sheets("Main").Cells(3, CL).Value) > 0 Then

        PvFld = Sheets("Main").Cells(3, CL).Value
        PvFSu = "Сумма по полю " & PvFld
        PvCSr = "Среднее по полю " & PvFld
        
        Select Case Sheets("Main").Cells(3, CL).Value
            
            Case Is = "earTcndl", _
                        "RTC connection success rate, %", _
                        "ERAB setup success rate, %", _
                        "DL Avg PRB Usage (%)", _
                        "MSST, %", _
                        "Cels av", _
                        "DL user thrt, Mbps", _
                        "Act Users"

                ActiveSheet.PivotTables(PvTab).AddDataField ActiveSheet.PivotTables _
                    (PvTab).PivotFields(PvFld), PvFSu, xlSum
                With ActiveSheet.PivotTables(PvTab).PivotFields(PvFSu)
                    .Caption = PvCSr
                    .Function = xlAverage
                End With
                
            Case Is = "DL trac, MB"
                ActiveSheet.PivotTables(PvTab).AddDataField ActiveSheet.PivotTables _
                    (PvTab).PivotFields(PvFld), PvFSu, xlSum
                With ActiveSheet.PivotTables(PvTab).PivotFields(PvFSu)
                    .Caption = PvCSr
                    .Function = xlMin
                End With
            
            Case Else
                '
        End Select
    End If
Next
Application.ScreenUpdating = True
End Sub

RoDaMa · 29.05.2020, 23:46

работает
Elixi огромное спасибо
я не знал что можно так сократить код
у меня коды с макроса

вот сам рабочий код:

Код:

Sub Pivot_01()
Application.ScreenUpdating = False
For Each Sh In Worksheets
    Select Case Sh.Name
        Case Is = "Main"     ', "Weekpivot_A"
        Case Else
            Application.DisplayAlerts = False
            Sh.Delete
            Application.DisplayAlerts = True
    End Select
Next Sh
'Stop

'add sheets pivot
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Weekpivot"

    PvTab = "PivotTable4"

'insert PivotTable & first row PivotFields("EUtCels Id")

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _
        DefaultVersion:=xlPivotTableVersion14
        With ActiveSheet.PivotTables(PvTab).PivotFields("EUtCels Id")
            .Orientation = xlRowField
            .Position = 1
        End With

'все остальные поля будут вставляться по порядку названии на строке 3 в листе Main

For CL = 1 To Sheets("Main").Cells(3, Columns.Count).End(xlToLeft).Column
    'Debug.Print Cells(3, CL).Value
    If Len(Sheets("Main").Cells(3, CL).Value) > 0 Then

        PvFld = Sheets("Main").Cells(3, CL).Value
        PvFSu = "Сумма по полю " & PvFld
        PvCSr = "Среднее по полю " & PvFld
        PvCSmin = "Минимум по полю " & PvFld
        Select Case Sheets("Main").Cells(3, CL).Value
            
            Case Is = "earTcndl", _
                        "RTC connection success rate, %", _
                        "ERAB setup success rate, %", _
                        "DL Avg PRB Usage (%)", _
                        "MSST, %", _
                        "Cels av", _
                        "DL user thrt, Mbps", _
                        "Act Users"

                ActiveSheet.PivotTables(PvTab).AddDataField ActiveSheet.PivotTables _
                    (PvTab).PivotFields(PvFld), PvFSu, xlSum
                With ActiveSheet.PivotTables(PvTab).PivotFields(PvFSu)
                    .Caption = PvCSr
                    .Function = xlAverage
                End With
                
            Case Is = "DL trac, MB"
                ActiveSheet.PivotTables(PvTab).AddDataField ActiveSheet.PivotTables _
                    (PvTab).PivotFields(PvFld), PvFSu, xlSum
                With ActiveSheet.PivotTables(PvTab).PivotFields(PvFSu)
                    .Caption = PvCSmin
                    .Function = xlMin
                End With
            
            Case Else
                '
        End Select
    End If
Next
Application.ScreenUpdating = True
End Sub

Elixi · 30.05.2020, 13:40

Цитата:

Сообщение от RoDaMa

я не знал что можно так сократить код

сокрачщение на пользу будущим переработкам макроса,
на счет быстроты выполнения не ручаюсь

из кода можно еще выбросить строку
If Len(Sheets("Main").Cells(3, CL).Value) > 0 Then
и ее соответсвующее End If
они здесь бесполезны

RoDaMa · 31.05.2020, 15:45

Чут доработал код
добавил переменные для обработки всех данных в листе.
теперь не зависимо какого размера будет таблица при создании сводной таблицы все данные будут обрабатываться

Добавил переменные :lRow и lCol
и определил последняя строка в активном листе = lRow
и определил последняя столбец в активном листе = lCol

Код:

Dim lRow As Long
Dim lCol As Long
On Error Resume Next
    lRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
    
    On Error Resume Next
    lCol = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Column
    On Error Resume Next

код с жестким определенными ячейками в создание сводной таблицы -Main!R3C1:R23C19:

Код:

'insert PivotTable & first row PivotFields("EUtCels Id")

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _
        DefaultVersion:=xlPivotTableVersion14[/QUOTE]

всавил переменные в код создание сводной таблицы, теперь данные могут быт любого размера, формула сама определит последную строку и столбец и обработает данные:

Код:

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Main!R3C1:R" & lRow & "C" & lCol, Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _
        DefaultVersion:=xlPivotTableVersion14

28.05.2020, 20:52	#3
Elixi Форумчанин Регистрация: 10.05.2019 Сообщений: 172	... поправлено выше ... Последний раз редактировалось Elixi; 28.05.2020 в 20:55.

31.05.2020, 15:45	#10
RoDaMa Пользователь Регистрация: 16.03.2020 Сообщений: 24	Чут доработал код добавил переменные для обработки всех данных в листе. теперь не зависимо какого размера будет таблица при создании сводной таблицы все данные будут обрабатываться Добавил переменные :lRow и lCol и определил последняя строка в активном листе = lRow и определил последняя столбец в активном листе = lCol Код: `Dim lRow As Long Dim lCol As Long On Error Resume Next lRow = Cells.Find(What:="", _ After:=Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error Resume Next lCol = Cells.Find(What:="", _ After:=Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error Resume Next` код с жестким определенными ячейками в создание сводной таблицы -Main!R3C1:R23C19: Код: `'insert PivotTable & first row PivotFields("EUtCels Id") ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Main!R3C1:R23C19", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _ DefaultVersion:=xlPivotTableVersion14[/QUOTE]` всавил переменные в код создание сводной таблицы, теперь данные могут быт любого размера, формула сама определит последную строку и столбец и обработает данные: Код: `ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Main!R3C1:R" & lRow & "C" & lCol, Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Weekpivot!R3C1", TableName:=PvTab, _ DefaultVersion:=xlPivotTableVersion14` Последний раз редактировалось RoDaMa; 31.05.2020 в 15:56.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Выборка уникальных данных из Pivot-таблицы	JVG	Microsoft Office Excel	0	10.04.2015 14:03
При создании сводной не видит часть столбцов	KaSS	Microsoft Office Excel	0	24.10.2013 08:03
Обновление сводной таблицы	danichca	Microsoft Office Excel	4	22.02.2013 13:10
Заполнение сводной таблицы	Nikolas8	Microsoft Office Excel	1	04.06.2010 22:09
Данные из двух полей исх. таблицы в одно поле сводной таблицы	Strelec79	Microsoft Office Excel	2	02.08.2009 13:59