Question

我在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

我已经编写了一段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个不同的工作表名称，这就是为什么我猜测工作表的默认值为工作表Sheet1！我认为可以通过使用偏移来根据活动单元格获取团队名称或列名称来生成名称，但我不确定从哪里开始，所以任何建议/帮助将不胜感激！

由于

Answer 1

我希望我能评论，但我还不能，因为我没有足够的重复点！（不得不重启我的帐户！）

我可以建议您在手动向下钻取任何给定数据点时录制宏，并查看录制的vba代码的外观。我想从那里你可以配置你的代码，使你的工作表的名称基于录制代码的某些元素。

因为，我希望这是一个评论，如果它没有用，我会删除它。

更新至您新发布的答案：

要在用户向下钻取时检查工作表是否已存在，您可以在获取工作表名称后检查工作表是否存在，如果存在，请选择它，而不是创建新工作表。否则，你创建它。

请参阅此代码：

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

Answer 2

我设法提出了一些相当可行的方法：

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

基本上，它被添加到新闻表事件中 - 宏将新工作表添加到工作簿的末尾，转到数据透视表表并标识活动单元格的列名和行名（因为列名和行名将永远是静态的我可以硬编码），然后找到新添加的工作表（总是在工作簿的末尾）并重命名它。不幸的是，如果用户试图两次钻取相同的数据（不能有两个具有相同名称的工作表），那么就会出现问题，我希望能够解决这个问题。

感谢您提出意见/评论。

编辑：更新代码以解决工作表重复问题，似乎正在做这个伎俩！

使用VBA重命名基于数据透视钻取的工作表名称

2 个答案: