Question

我的宏从设置的数据转储中从头开始创建数据透视表。我正在尝试将此宏移至外接程序。该加载项每次都可以处理新数据，但是由于某种原因，它会弹出我的代码最初使用的第二个工作簿。

我已经阅读了外接程序网站，以确保我正确设置了外接程序。我的其他附加宏也可以工作（只有2个还在学习中）

Sub OpenAndHoldPivot()

    Dim sht As Worksheet
    Dim pvtCache As PivotCache
    Dim pvt As PivotTable
    Dim StartPvt As String
    Dim SrcData As String

'Determine the data range you want to pivot

    Dim finRow As String
    With ActiveWorkbook
    finRow = ActiveSheet.Range("A200000").End(xlUp).Row
    SrcData = ActiveSheet.Name & "!" & Range("A4:BO" & finRow - 1).Address  (ReferenceStyle:=xlR1C1)
    End With

'Create a new worksheet

    Set sht = Sheets.Add

'Pivot Table Start

    StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data

     Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
     SourceType:=xlDatabase, _
     SourceData:=SrcData)

'Create Pivot table from Pivot Cache

     Set pvt = pvtCache.CreatePivotTable( _
     TableDestination:=StartPvt, _
     TableName:="PivotTable1")

'------------------------------------------------------------------------------


    Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Add item to the Report Filter

    pvt.PivotFields("Future Fill Date").Orientation = xlPageField

'Add item to the Column Labels

    pvt.PivotFields("Worker Type").Orientation = xlColumnField

'Add item to the Row Labels

    pvt.PivotFields("Flex Division").Orientation = xlRowField

'Turn on Automatic updates/calculations --like screenupdating to speed up code

    pvt.ManualUpdate = False

'------------------------------------------------------------------------------


    ActiveSheet.Name = "Pivot"


'------------------------------------------------------------------------------

    Dim pf As String
    Dim pf_Name As String

    pf = "FT/PT"
    pf_Name = "Sum of FT/PT"

    Set pvt = ActiveSheet.PivotTables("PivotTable1")

    pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount

'------------------------------------------------------------------------------

    Dim pm As PivotField

    Set pm = ActiveSheet.PivotTables("PivotTable1").PivotFields("Future Fill Date")

'Clear Out Any Previous Filtering

    pm.ClearAllFilters

'Filter on 2014 items

    pm.CurrentPage = "(blank)"
'------------------------------------------------------------------------------


    Sheets("Sheet1").Name = "Data"


End Sub

关于我在做什么错的任何想法吗？

Answer 1

我真的认为您的问题在于所使用的工作簿或工作表的引用不一致（或缺乏引用）。具体来说，我认为问题出在线路上

Set sht = Sheets.Add

由于您的Sheets参考未指定要添加新工作表的工作簿，因此它将默认为当前活动的工作簿，它可能是您的外接工作簿。如果您对想要的工作簿和工作表有了更清晰的了解，将会大有帮助。为了用您的例子说明这一点，您可以从

开始

Sub OpenAndHoldPivot()
    Dim workingWB As Workbook
    Dim workingWS As Worksheet
    Set workingWB = ActiveWorkbook
    Set workingWS = activeworksheet

    'Determine the data range you want to pivot
    Dim srcData As Range
    Dim srcDataText As String
    With workingWS
        Dim finRow As Long
        finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set srcData = .Range("A4").Resize(finRow - 1, 67)
        srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
    End With

这可以清楚地确定您所有代码将使用哪个工作簿。另外，如果您查看我的With块并将其与您的块进行比较，您会发现您在.引用之前错过了一个Range，这可能会再次引用您的任一加载项或有效的工作簿（永远不能太确定。

在那之后，我继续下面的代码...

    'Create a new worksheet in the working workbook
    Dim pivotWS As Worksheet
    Set pivotWS = workingWB.Sheets.Add

    'Pivot Table Start
    Dim StartPvtText As String
    StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)

    'Create Pivot Cache from Source Data
    Dim pvtCache As PivotCache
    Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
                   SourceType:=xlDatabase, _
                   SourceData:=srcDataText)

    'Create Pivot table from Pivot Cache
    Dim pvt As PivotTable
    Set pvt = pvtCache.CreatePivotTable( _
              TableDestination:=StartPvtText, _
              TableName:="PivotTable1")

还请注意，我声明了所有变量，使其尽可能靠近使用它们的位置。这样可以更轻松地进行跟踪，并确保您使用的是预期类型的正确变量。

进一步处理代码，您已经多次引用ActiveSheet。为了保持一致，请用特定的引用替换该引用。在我的代码中，我很少使用ActiveSheet或ActiveCell。我试图在完整的模块中修复下面的引用，但只有您可以知道这是否正确（因为并不确定您想要哪本书或纸页）。

最后，有最后一行代码Sheets("Sheet1").Name = "Data"。我不知道应该参考哪个工作簿，但是我猜应该是workingWB.Sheets("Sheet1").Name = "Data"。

Option Explicit

Sub OpenAndHoldPivot()
    Dim workingWB As Workbook
    Dim workingWS As Worksheet
    Set workingWB = ActiveWorkbook
    Set workingWS = activeworksheet

    'Determine the data range you want to pivot
    Dim srcData As Range
    Dim srcDataText As String
    With workingWS
        Dim finRow As Long
        finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set srcData = .Range("A4").Resize(finRow - 1, 67)
        srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
    End With

    'Create a new worksheet in the working workbook
    Dim pivotWS As Worksheet
    Set pivotWS = workingWB.Sheets.Add

    'Pivot Table Start
    Dim StartPvtText As String
    StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)

    'Create Pivot Cache from Source Data
    Dim pvtCache As PivotCache
    Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
                   SourceType:=xlDatabase, _
                   SourceData:=srcDataText)

    'Create Pivot table from Pivot Cache
    Dim pvt As PivotTable
    Set pvt = pvtCache.CreatePivotTable( _
              TableDestination:=StartPvtText, _
              TableName:="PivotTable1")

    '------------------------------------------------------------------------------
    Set pvt = pivotWS.PivotTables("PivotTable1")

    'Add item to the Report Filter
    pvt.PivotFields("Future Fill Date").Orientation = xlPageField

    'Add item to the Column Labels
    pvt.PivotFields("Worker Type").Orientation = xlColumnField

    'Add item to the Row Labels
    pvt.PivotFields("Flex Division").Orientation = xlRowField

    'Turn on Automatic updates/calculations --like screenupdating to speed up code
    pvt.ManualUpdate = False

    '------------------------------------------------------------------------------
    pivotWS.Name = "Pivot"

    '------------------------------------------------------------------------------
    Dim pf As String
    Dim pf_Name As String
    pf = "FT/PT"
    pf_Name = "Sum of FT/PT"
    Set pvt = pivotWS.PivotTables("PivotTable1")
    pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount

    '------------------------------------------------------------------------------
    Dim pm As PivotField
    Set pm = pivotWS.PivotTables("PivotTable1").PivotFields("Future Fill Date")

    'Clear Out Any Previous Filtering
    pm.ClearAllFilters

    'Filter on 2014 items
    pm.CurrentPage = "(blank)"

    '------------------------------------------------------------------------------
    workingWB.Sheets("Sheet1").Name = "Data"
End Sub

Excel宏加载项重复电子表格弹出

1 个答案: