2

我在 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 Doc 2”） - 我认为可能会出现 15 个不同的工作表名称，这就是为什么我猜测工作表默认为表1！一世'

谢谢

4

2 回答 2

2

我希望我可以发表评论，但我还不能，因为我没有足够的代表点！（不得不重新启动我的帐户！）

我可以建议您在手动钻取任何给定数据点时录制宏，并查看录制的 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
于 2012-08-02T13:15:10.993 回答
1

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

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

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

感谢您的意见/评论。

编辑：更新代码以解决工作表重复问题，似乎可以解决问题！

于 2012-08-02T13:42:05.423 回答