问题描述
这是很新的东西,但我会尽力让我的问题更容易理解.
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!
PivotTable.ShowPages Method (Excel)
语法
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
这篇关于基于列中的值的循环数据透视表过滤器的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!