Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 28.05.2020, 14:34   #1
RoDaMa
Пользователь
 
Регистрация: 16.03.2020
Сообщений: 19
По умолчанию условие при создании PIVOT (сводной таблицы)

День добрый

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

название строки постоянно на 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
Вложения
Тип файла: xls PivotWithIf.xlsm.xls (33.9 Кб, 3 просмотров)

Последний раз редактировалось RoDaMa; 28.05.2020 в 15:03.
RoDaMa вне форума Ответить с цитированием
Старый 28.05.2020, 20:49   #2
Elixi
Пользователь
 
Регистрация: 10.05.2019
Сообщений: 77
По умолчанию

Код:
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:54.
Elixi вне форума Ответить с цитированием
Старый 28.05.2020, 20:52   #3
Elixi
Пользователь
 
Регистрация: 10.05.2019
Сообщений: 77
По умолчанию

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

Последний раз редактировалось Elixi; 28.05.2020 в 20:55.
Elixi вне форума Ответить с цитированием
Старый 29.05.2020, 06:15   #4
RoDaMa
Пользователь
 
Регистрация: 16.03.2020
Сообщений: 19
По умолчанию

Доброе утро

мне необходимо чтобы при создании сводной таблицы и обработка данных было по условию
если значение ячейки= 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
RoDaMa вне форума Ответить с цитированием
Старый 29.05.2020, 14:43   #5
Elixi
Пользователь
 
Регистрация: 10.05.2019
Сообщений: 77
По умолчанию

Цитата:
Сообщение от 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 сделать.
Elixi вне форума Ответить с цитированием
Старый 29.05.2020, 22:03   #6
RoDaMa
Пользователь
 
Регистрация: 16.03.2020
Сообщений: 19
По умолчанию

ругаеться что выбор 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
Вложения
Тип файла: rar PivotWithIf.xlsm.rar (19.4 Кб, 4 просмотров)
RoDaMa вне форума Ответить с цитированием
Старый 29.05.2020, 22:39   #7
Elixi
Пользователь
 
Регистрация: 10.05.2019
Сообщений: 77
По умолчанию

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

Код:
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
Elixi вне форума Ответить с цитированием
Старый 29.05.2020, 23:46   #8
RoDaMa
Пользователь
 
Регистрация: 16.03.2020
Сообщений: 19
По умолчанию

работает
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
RoDaMa вне форума Ответить с цитированием
Старый 30.05.2020, 13:40   #9
Elixi
Пользователь
 
Регистрация: 10.05.2019
Сообщений: 77
По умолчанию

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

из кода можно еще выбросить строку
If Len(Sheets("Main").Cells(3, CL).Value) > 0 Then
и ее соответсвующее End If
они здесь бесполезны
Elixi вне форума Ответить с цитированием
Старый 31.05.2020, 15:45   #10
RoDaMa
Пользователь
 
Регистрация: 16.03.2020
Сообщений: 19
По умолчанию

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

Добавил переменные :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.
RoDaMa вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


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


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS