vba를 사용하여 피벗 테이블을 만드는 방법

Question

저는 VBA에서 초보자이며 Excel에서 VBA를 사용하여 PivotTable을 만들려고합니다.

입력 용지와 같이 아래 이미지처럼 생성하고 싶습니다.

나는 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 

Answer 1

이 일부 정리하는 필요하지만 당신은 시작할 수 있습니다.

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 

Answer 2

내 대답의 코드는 약간 길지만 찾고자하는 결과를 제공해야합니다.

먼저 안전 측면을 확인하려면 Raw_data 통합 문서 개체에 이미 "Pivottable" 시트가 있는지 확인하십시오 (다시 만들 필요 없음).

둘째는, 코드가이 개 부분에 중간에 나누어 져 매크로가 (이 당신이 그것을 실행하는 2 + 배) 이전에 실행 된 경우

은

1. 은 다음 "PRIMEPivotTable" 피벗 - 테이블은 이미 생성되어 , 다시 만들거나 Pivot-Table의 필드를 설정할 필요가 없습니다. 업데이트 된(업데이트 된 피벗 캐시의 소스 범위 포함)으로 PivotTable을 새로 고치기 만하면됩니다.
2. 이 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 PSheet 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