Comment créer un tableau croisé dynamique à l'aide de vba

Question

Je suis novice en vba et j'essaie de créer un PivotTable en utilisant VBA avec Excel.

Je voudrais créer comme l'image ci-dessous comme feuille d'entrée.

J'essaie d'ajouter des étiquettes de ligne de region, month, number, status et les valeurs sont value1, value2 et total ici, je suis en mesure de définir la plage de pivot, tandis que son exécution crée une feuille "pivotable" uniquement. ne génère aucun tableau croisé dynamique pour sheet1.

Mon code :

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

Cela nécessite un certain rangement, mais devrait vous aider à démarrer.

Notez l'utilisation d'Option Explicit pour que les variables doivent être déclarées.

Les noms des colonnes sont conformes à votre classeur fourni.

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

Le code dans ma réponse ci-dessous est un peu long, mais il devrait vous fournir le résultat que vous recherchez.

Tout d'abord, pour être prudent, vérifiez d'abord si "Pivottable" la feuille existe déjà dans Raw_data objet classeur (pas besoin de le recréer).

Deuxièmement, le code est divisé au milieu en 2 sections:

1. Si la MACRO a été exécutée auparavant (ce sont les 2+ fois que vous l'exécutez), alors "PRIMEPivotTable" Le tableau croisé dynamique est déjà créé et il n'est pas nécessaire de le recréer ni de configurer les champs du tableau croisé dynamique. Tout ce que vous devez faire est d'actualiser le PivotTable avec la mise à jour PivotCache (avec la plage source de Pivot-Cache mise à jour).
2. Si c'est la première fois que vous exécutez cette MACRO, vous devez configurer le PivotTable et tous les PivotFields nécessaires.

Explication détaillée de chaque étape dans les commentaires du code.

Code

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