使用 VBA 根据数据透视钻重命名工作表名称
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11776353/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Rename worksheet name based on pivot drill with VBA
提问by bawpie
I have a pivot table in excel which looks like this:
我在 excel 中有一个数据透视表，如下所示：
Team Doc 1 Doc 2 Grand Total
Team A 13 12 25
Team B 8 7 15
Team C 32 5 37
Grand Total 53 24 77
I have already written a piece of VBA which will format any drill down sheets for printing (Workbook_NewSheet(ByVal Sh As Object)). However, as I'm trying to make this as user friendly as possible, I'd really like to be able to use vba to automatically rename any worksheets generated from the pivot table. However, I'm not sure how to do it as the content of each worksheet will be different depending on where the user clicks (i.e. if the user clicks in Team A Doc 1 Total then the sheet should be named 'Team A Doc 1' but if the user clicks in Grand Total row of Doc 2 then the sheet should be named 'Grand Total Doc 2') - I think there are something like 15 different worksheet names that could occur which is why I'm guessing the worksheet defaults to Sheet1! I'm thinking that a name could be generated by using offset to pick up the team name or the column name based on the active cell but I'm not really sure where to start so any suggestions/assistance would be greatly appreciated!
我已经编写了一段 VBA，它将格式化任何用于打印的钻取表（Workbook_NewSheet(ByVal Sh As Object)）。但是，由于我试图使其尽可能用户友好，我真的希望能够使用 vba 自动重命名从数据透视表生成的任何工作表。但是，我不确定该怎么做，因为每个工作表的内容会根据用户单击的位置而有所不同（即，如果用户在 Team A Doc 1 Total 中单击，则该工作表应命名为“Team A Doc 1”但是如果用户单击 Doc 2 的 Grand Total 行，则该工作表应命名为“Grand Total Doc 2”）-我认为可能会出现 15 个不同的工作表名称，这就是为什么我猜测工作表默认为表 1！一世'
Thanks
谢谢
采纳答案by bawpie
I've managed to come up with something fairly workable:
我设法想出了一些相当可行的方法：
Private Sub Workbook_NewSheet(ByVal sh As Object)
Dim RN, CN As Byte
Dim SheetName As String
Application.ScreenUpdating = False
ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
'Names the sheet according to the pivot drill
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
'Identifies if worksheet already exists and replaces it if so.
Application.DisplayAlerts = False
On Error Resume Next
mySheetNameTest = Worksheets(SheetName).Name
If Err.Number = 0 Then
Worksheets(SheetName).Delete
MsgBox "The sheet named ''" & SheetName & "'' already exists but will be replaced."
Else
Err.Clear
End If
Application.DisplayAlerts = True
Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Name = SheetName
End Sub
Basically it's added onto the newsheet event - the macro adds the new sheet to the end of the workbook, goes to the pivot table sheet and identifies the column and row names of the active cell (since the column name and row name will always be static I can hard code this in) and then locates the newly added sheet (always at the end of the workbook) and renames it. Unfortunately there's an issue if a user tries to drill on the same data twice (can't have two worksheets with the same name) which I'm hoping to iron out.
基本上它被添加到 newsheet 事件 - 宏将新工作表添加到工作簿的末尾，转到数据透视表工作表并标识活动单元格的列名和行名（因为列名和行名将始终是静态的我可以对其进行硬编码），然后找到新添加的工作表（总是在工作簿的末尾）并重命名它。不幸的是，如果用户试图对相同的数据进行两次钻取（不能有两个同名的工作表），我希望解决这个问题。
Thanks for views/comments.
感谢您的意见/评论。
Edit: Updated code to work around worksheet duplication issue, seems to be doing the trick!
编辑：更新代码以解决工作表重复问题，似乎可以解决问题！
回答by Scott Holtzman
I wish I could comment, but I can't yet, as I have not enough rep points! (Had to restart my account!)
我希望我可以发表评论，但我还不能，因为我没有足够的代表点！（必须重新启动我的帐户！）
I can suggest that you record a macro while you do a drill down on any given data point manually, and see how the recorded vba code looks. I would think from there you can configure your code to base the name of your worksheet on some element of the recorded code.
我可以建议您在手动向下钻取任何给定数据点的同时录制一个宏，并查看录制的 vba 代码的外观。我认为从那里您可以配置您的代码以将您的工作表的名称基于已记录代码的某些元素。
Since, I wanted this to be a comment, I will delete this if it's not helpful.
因为，我希望这是一个评论，如果它没有帮助，我会删除它。
Update To Your Newly Posted Answer:
更新您新发布的答案：
To check if the sheet already exists when a user drills down, you can check if the sheet existss after you get the sheet name to and if it does, select it, rather than creating a new one. Otherwise, you create it.
要在用户向下钻取时检查工作表是否已存在，您可以在获取工作表名称后检查工作表是否存在，如果存在，则选择它，而不是创建新的工作表。否则，您创建它。
See this code for that:
请参阅此代码：
Private Sub Workbook_NewSheet(ByVal sh As Object)
Application.ScreenUpdating = False
Dim shtCur As Worksheet
Set shtCur = ActiveSheet
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
If SheetExists(SheetName) Then
Worksheets(SheetName).Select
Else
shtCur.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
shtCur.Name = "SheetName"
End If
Application.ScreenUpdating = True
End Sub
Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
SheetExists = False
Dim WS As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set WS = wb.Worksheets(wsName)
On Error GoTo 0
If Not WS Is Nothing Then SheetExists = True
End Function
