@QHarr может быть мной, я не помню, есть недели, которые я не могу вспомнить, какие сообщения я прочитал, или даже сам ответил (и я иду, чтобы проверить их). У меня нет ничего интересного в разделе "обо мне", к сожалению

ичок в VBA и пытаюсь создатьPivotTable используя VBA с Excel.

Я хотел бы создать как ниже изображение в качестве входного листа.

Я пытаюсь добавить метки строкregion, month, number, status и значенияvalue1, value2 а такжеtotal здесь я могу установить диапазон для сводной таблицы, при ее выполнении создается только «сводная таблица». не генерировать сводную таблицу для sheet1.

Мой код:

Option Explicit

Public Sub Input_File__1()

ThisWorkbook.Sheets(1).TextBox1.Text = Application.GetOpenFilename()

End Sub

'======================================================================

Public Sub Output_File_1()

Dim get_fldr, item As String
Dim fldr As FileDialog

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo nextcode:

    item = .SelectedItems(1)
    If Right(item, 1) <> "\" Then
        item = item & "\"
    End If
End With

nextcode:
get_fldr = item
Set fldr = Nothing
ThisWorkbook.Worksheets(1).TextBox2.Text = get_fldr

End Sub

'======================================================================

Public Sub Process_start()

Dim Raw_Data_1, Output As String
Dim Raw_data, Start_Time As String
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

Start_Time = Time()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text

Workbooks.Open Raw_Data_1: Set Raw_data = ActiveWorkbook
Raw_data.Sheets("Sheet1").Activate

On Error Resume Next

'Worksheets("Sheet1").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "Pivottable"

Application.DisplayAlerts = True

Set PSheet = Worksheets("Pivottable")
Set DSheet = Worksheets("Sheet1")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).coloumn
Set PRange = DSheet.Range("A1").CurrentRegion

Set PCache = ActiveWorkbook.PivotCaches.Create_(SourceType:=xlDatabase, SourceData:=PRange)

Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")

With PTable.PivotFields("Region")
    .Orientation = xlRowField
    .Position = 1
End With
 love mam25 нояб. 2017 г., 16:49
поворот не создать для первого ряда в качестве региона
 love mam25 нояб. 2017 г., 16:51
Да, я уже создал его, который работает нормально. но я пытаюсь заставить его работать динамически для любого входа
 QHarr25 нояб. 2017 г., 16:47
Закомментируйте резюме об ошибке рядом и выполните код с помощью F8, чтобы увидеть, где могут быть проблемы. Поясните в вопросе, что работает не так, как вы хотели бы, и что вы пытались. Какой-то код отсутствует?
 QHarr25 нояб. 2017 г., 16:50
Вы пытались создать пивот вручную и с помощью макро-рекордера? Это даст вам приблизительный синтаксис. Также исправьте орфографическую ошибку.
 QHarr25 нояб. 2017 г., 16:44
Какие ошибки вы получаете и где? Здесь есть как минимум одна орфографическая ошибка LastCol = DSheet.Cells (1, Columns.Count) .End (xlToLeft) .coloumn <= column

Ответы на вопрос(2)

Обратите внимание на использование Option Explicit, поэтому переменные должны быть объявлены.

Имена столбцов соответствуют вашей прилагаемой книге.

Option Explicit

Sub test()

     Dim PSheet As Worksheet
     Dim DSheet As Worksheet
     Dim LastRow As Long
     Dim LastCol As Long
     Dim PRange As Range
     Dim PCache As PivotCache
     Dim PTable As PivotTable

     Sheets.Add
     ActiveSheet.Name = "Pivottable"

    Set PSheet = Worksheets("Pivottable")
    Set DSheet = Worksheets("Sheet1")

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Range("A1").CurrentRegion

    Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)

    Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")

    With PTable.PivotFields("Region")
        .Orientation = xlRowField
        .Position = 1
    End With

    With PTable.PivotFields("Channel")
        .Orientation = xlRowField
        .Position = 2
    End With

    With PTable.PivotFields("AW code")
        .Orientation = xlRowField
        .Position = 3
    End With

    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("Bk"), "Sum of Bk", xlSum
    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("DY"), "Sum of DY", xlSum
    PTable.AddDataField PSheet.PivotTables _
        ("PRIMEPivotTable").PivotFields("TOTal"), "Sum of TOTal", xlSum

End Sub
 Shai Rado26 нояб. 2017 г., 10:00
тоже приятно, просто по модулю названияPivotFields соответствовать этому посту :)

но он должен дать вам результат, который вы ищете.

Во-первых, чтобы быть в безопасности, сначала проверьте, если"Pivottable" лист уже существует вRaw_data объект книги (не нужно создавать его снова).

Во-вторых, код разделен в середине на 2 раздела:

Если MACRO запускался раньше (это более 2 раз, когда вы его запускаете), тогда"PRIMEPivotTable" Сводная таблица уже создана, и нет необходимости создавать ее заново или настраивать поля сводной таблицы. Все, что вам нужно сделать, это обновитьPivotTable с обновленнымPivotCache (с обновленным исходным диапазоном Pivot-Cache).Если это первый запуск этого MACRO, то вам нужно настроитьPivotTable и все необходимоеPivotFields.

Подробное объяснение каждого шага в комментариях к коду.

Код

Option Explicit

Sub AutoPivot()

Dim Raw_data As Workbook
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim LastRow As Long, LastCol As Long
Dim Raw_Data_1 As String, Output As String, Start_Time As String

Start_Time = Time()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text

' set the WorkBook object
Set Raw_data = Workbooks.Open(Raw_Data_1)

Set DSheet = Raw_data.Worksheets("Sheet1")

' first check if "Pivottable" sheet exits (from previous MACRO runs)
On Error Resume Next
Set PSheet = Raw_data.Sheets("Pivottable")
On Error GoTo 0

If PShee,t Is Nothing Then '
    Set PSheet = Raw_data.Sheets.Add(before:=Raw_data.ActiveSheet) ' create a new worksheet and assign the worksheet object
    PSheet.Name = "Pivottable"
Else ' "Pivottable" already exists
    ' do nothing , or something else you might want

End If

With DSheet
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    ' set the Pivot-Cache Source Range with the values found for LastRow and LastCol
    Set PRange = .Range("A1", .Cells(LastRow, LastCol))
End With

' set a new/updated Pivot Cache object
Set PCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address(True, True, xlA1, xlExternal))

' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PTable = PSheet.PivotTables("PRIMEPivotTable") ' check if "PRIMEPivotTable" Pivot-Table already created (in past runs of this Macro)

On Error GoTo 0
If PTable Is Nothing Then ' Pivot-Table still doesn't exist, need to create it
    ' create a new Pivot-Table in "Pivottable" sheet
    Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="PRIMEPivotTable")

    With PTable
        ' add the row fields
        With .PivotFields("Region")
            .Orientation = xlRowField
            .Position = 1
        End With
        With .PivotFields("month")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("number")
            .Orientation = xlRowField
            .Position = 3
        End With
        With .PivotFields("Status")
            .Orientation = xlRowField
            .Position = 4
        End With

        ' add the 3 value fields (as Sum of..)
        .AddDataField .PivotFields("value1"), "Sum of value1", xlSum
        .AddDataField .PivotFields("value2"), "Sum of value2", xlSum
        .AddDataField .PivotFields("TOTal"), "Sum of TOTal", xlSum
    End With

Else ' Pivot-Table "PRIMEPivotTable" already exists >> just update the Pivot-Table with updated Pivot-Cache (update Source Range)

     ' just refresh the Pivot cache with the updated Range
    PTable.ChangePivotCache PCache
    PTable.RefreshTable
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 Shai Rado26 нояб. 2017 г., 09:58
@QHarr LOL, спасибо :) слишком много свободного времени в воскресенье (и, возможно, слишком много ответов здесь на одно и то же дело, может быть, только на 95% похоже)
 QHarr26 нояб. 2017 г., 09:57
И это хорошая и аккуратная версия! +1
 QHarr26 нояб. 2017 г., 10:02
Правда. Но я не стал намного быстрее находить их (существующие ответы) снова. Я недавно видел хорошо приведенную в порядок версию, не так ли? Я заметил одного человека, который на самом деле включил свои наиболее часто упоминаемые посты и материалы в раздел «обо мне», что казалось довольно разумным.
 Shai Rado26 нояб. 2017 г., 10:04
@QHarr может быть мной, я не помню, есть недели, которые я не могу вспомнить, какие сообщения я прочитал, или даже сам ответил (и я иду, чтобы проверить их). У меня нет ничего интересного в разделе "обо мне", к сожалению

Ваш ответ на вопрос