基于列中的值的循环数据透视表过滤器 [英] Loop Pivot Table Filter based on values in column

问题描述

这是很新的东西，但我会尽力让我的问题更容易理解.

very new to this but I'll try to make my question simple to understand.

我有一个带有数据透视表的Excel工作表，我先对第一列(销售人员姓名)进行过滤，然后将过滤后的数据透视表复制粘贴到新的工作表中，并将其另存为销售人员姓名.

I have an Excel sheet with a pivot table which I filter through the first column (sales persons names) one by one, and then copy-pasting the filtered pivot table to a new worksheet and saving it as the sales persons name.

是否有可能使宏根据表(Table1)中的值循环通过第一列过滤器，然后将这些值复制到新的工作表中?宏的示例将很有帮助.

Is it possible to get a macro to loop through the first columns filter based on values in a table (Table1) and copy the values out to a new worksheet? An example of the macro would be helpful.

更新-我已经在某种程度上进行了一些管理，但是它正在复制数据透视表批发，然后尝试每行保存一个文件.

Update - I've managed something to some degree, but it is copying the pivottable wholesale, and then trying to save a file with each row.

Sub Gen()

Dim PvtTbl As PivotTable
Set PvtTbl = ActiveSheet.PivotTables("PivotTable1")
Dim Field As PivotField
Set Field = ActiveSheet.PivotTables("PivotTable1").PivotFields("SPerson")
Dim PvtItm As PivotItem
Dim Range As Range
Dim i As Long
Dim var As Variant


Application.ScreenUpdating = False


For Each PvtItm In Field.PivotItems
    ActiveSheet.Range("$A$11").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs ("C:\" & ActiveSheet.Range("$B$2") & Format(Date, "yyyy - mm") & ".xlsx")
Next PvtItm


Application.ScreenUpdating = True


End Sub`

其中$ A $ 11是数据透视表，$ B $ 2是我要将文件另存为的销售人员的名字.

Where $A$11 is the pivottable and $B$2 is the name of the salesperson I want to save the file as.

推荐答案

2个版本:

版本1，使用循环来选择可透视表项.

Version 1 with use of loops to select pivottable items.

版本2，使用数据透视表的.ShowPages方法.

Version 2 using .ShowPages method of pivottable.

我猜测方法1应该更有效.

I am guessing method 1 should be more efficient.

在最初的几次运行中，没有其他任何运行，我惊讶地发现.ShowPages更快.平均时间为2.398秒，而版本1则为3.263秒.

In an initial couple of runs, with nothing else running, I was surprised to see the .ShowPages was quicker; with an average 2.398 seconds, versus version 1, which took 3.263 seconds.

注意事项:这只是时序的几次测试，由于我的编码可能会有所不同，但也许值得探讨?没有使用其他优化方法.当然，还有其他可能.

Caveat: This was only a few test runs for timing, and there may be differences due to my coding, but maybe worth exploring? No other optimization methods used. There are others, of course, possible.

版本1:

Option Explicit
Sub GetAllEmployeeSelections()

    Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet3")
    Set pvt = ws.PivotTables("PivotTable1")

    Application.ScreenUpdating = False

    Dim pvtField As PivotField
    Dim item As Long
    Dim item2 As Long

    Set pvtField = pvt.PivotFields("SPerson")

    For item = 1 To pvtField.PivotItems.Count

          pvtField.PivotItems(item).Visible = True

          For item2 = 1 To pvtField.PivotItems.Count

              If item2 <> item Then pvtField.PivotItems(item2).Visible = False

          Next item2

        Dim newBook As Workbook
        Set newBook = Workbooks.Add

        With newBook

            Dim currentName As String
            currentName = pvtField.PivotItems(item).Name

            .Worksheets(1).Name = currentName

            pvt.TableRange2.Copy

            Worksheets(currentName).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

           .SaveAs Filename:=filePath & currentName & ".xlsx"

           .Close

        End With

        Set newBook = Nothing

    Next item

    Application.ScreenUpdating = True

End Sub

版本2:

为什么不利用PivotTable的.ShowPages方法并将您的sPerson作为页面字段参数?它循环指定的pagefield并为每个具有该项目值的项目生成一个工作表.然后，您可以再次循环字段项目，并将数据导出到新工作簿，保存，然后删除创建的工作表.

Why not leverage the .ShowPages method of PivotTable and have your sPerson as the page field argument? It loops the pagefield specified and generates a sheet for each item with that item's value. You can then loop again the fields items and export the data to new workbooks, save, and then delete the created sheets.

可能有点矫over过正！

It is probably a bit overkill!

数据透视表. ShowPages方法(Excel)

PivotTable.ShowPages Method (Excel)

为页面字段中的每个项目创建一个新的数据透视表报表.每个 在新的工作表上创建新的报告.

Creates a new PivotTable report for each item in the page field. Each new report is created on a new worksheet.

语法

expression. ShowPages(PageField)

expression . ShowPages( PageField )

expression一个表示数据透视表对象的变量.

expression A variable that represents a PivotTable object.

代码:

 Option Explicit
'Requires all items selected

Sub GetAllEmployeeSelections2()

    Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet3")
    Set pvt = ws.PivotTables("PivotTable1")

    Application.ScreenUpdating = False

    Dim pvtField As PivotField
    Dim item As Variant

    Set pvtField = pvt.PivotFields("SPerson")

    pvtField.ClearAllFilters
    pvtField.CurrentPage = "(All)"

     For Each item In pvtField.PivotItems
        item.Visible = True
     Next item

    pvt.ShowPages "Employee"

    For Each item In pvtField.PivotItems

        Dim newBook As Workbook
        Set newBook = Workbooks.Add

        With newBook

            .Worksheets(1).Name = item.Name

            wb.Worksheets(item.Name).UsedRange.Copy

            Worksheets(item.Name).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

           .SaveAs Filename:=filePath & item.Name & ".xlsx"

           .Close

        End With

        Set newBook = Nothing

    Next item

    Application.DisplayAlerts = False

    For Each item In pvtField.PivotItems

         wb.Worksheets(item.Name).Delete

    Next item

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub

这篇关于基于列中的值的循环数据透视表过滤器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！