VBA通过Activecell选择数据透视表

时间:2018-09-27 07:50:56

标签: excel vba excel-vba

在我的Excel工作表中,每个月都要从另一个文件复制数据透视表,因此,每次将新的数据透视表复制到我的工作表时,名称都会更改。我想使用宏来设置数据透视表过滤器,但在不知道名称的情况下不知道如何引用该表。我使用下面的代码,它有时可以工作,但有时会出错。请问我的代码中是否有错误?还是我的情况还有其他解决方案?

另一个问题是,我的代码在两个工作表中调整了两个数据透视表,但是,有时(大部分时间)代码最终只能在一张纸上工作。有人知道原因吗?

Sub getdeb()
Dim irfile As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Please select a file"
    .ButtonName = "Select"
    .InitialFileName = "C:\"
    If .Show = -1 Then
        irfile = .SelectedItems(1)

        Set wbtarget = ThisWorkbook
        Set wbsource = Workbooks.Open(irfile)

        Set ws1 = wbsource.Sheets("NN Re inzake ART Non-Life")

        Set ws2 = wbsource.Sheets("NN Re inzake ART Life")

        ws2.Cells.Copy Destination:=wbtarget.Sheets("Life").Range("A1")

        ws1.Cells.Copy Destination:=wbtarget.Sheets("NonLife").Range("A1")

        wbsource.Close

        Else
            MsgBox "No file was selected"

    End If
End With

With ThisWorkbook

Set ws3 = Sheets("Life")
Set ws4 = Sheets("NonLife")
ws3.Cells.Clear
ws4.Cells.Clear

End With

With ws3

    With ActiveCell.PivotTable.PivotFields("GAUDI rubriek")
    .PivotItems("A_INT_RENTS_ACCR    ").Visible = False
    .PivotItems("A_OTH_ACCR_ASSETS   ").Visible = False
    .PivotItems("L_COST_PAYABLE      ").Visible = False
    .PivotItems("L_CRED_DIR          ").Visible = False
    .PivotItems("L_CRED_OTH_3P       ").Visible = False
    .PivotItems("L_CRED_OTH_IC       ").Visible = False
    .PivotItems("L_CRED_REINS_IC     ").Visible = False
    .PivotItems("L_DEF_TAX_LIAB      ").Visible = False
    .PivotItems("L_INCOME_TAX        ").Visible = False
    .PivotItems("L_INT_RENTS_ACCR    ").Visible = False
    .PivotItems("L_OTH_PROV          ").Visible = False
    .PivotItems("A_TAX_REC           ").Visible = False
    .PivotItems("L_CRED_REINS_3P     ").Visible = False
    End With

    With ActiveCell.PivotTable.PivotFields("Issuer")
    .ClearAllFilters
    .EnableMultiplePageItems = True
    .PivotItems(" ").Visible = False
    End With

    .Range("N9") = "GRID Mapping DvS"
    .Range("O9") = "GRID Name Mapping DvS"
    .Range("P9") = "Country Mapping DvS"
    .Range("Q9") = "Instrument ID DvS added"
    .Range("R9") = "Country Mapping DvS2"
    .Range("R9") = "Thomson-Reuters id"
    .Range("Q10") = "=$B10&"" ""&$A10"
    .Range("N10:R100").FillDown

End With

With ws4

    With ActiveCell.PivotTable.PivotFields("GAUDI rubriek")
    .PivotItems("A_INT_RENTS_ACCR    ").Visible = False
    .PivotItems("A_OTH_ACCR_ASSETS   ").Visible = False
    .PivotItems("L_COST_PAYABLE      ").Visible = False
    .PivotItems("L_CRED_DIR          ").Visible = False
    .PivotItems("L_CRED_OTH_3P       ").Visible = False
    .PivotItems("L_CRED_OTH_IC       ").Visible = False
    .PivotItems("L_CRED_REINS_IC     ").Visible = False
    .PivotItems("L_DEF_TAX_LIAB      ").Visible = False
    .PivotItems("L_INCOME_TAX        ").Visible = False
    .PivotItems("L_INT_RENTS_ACCR    ").Visible = False
    .PivotItems("L_OTH_PROV          ").Visible = False
    .PivotItems("A_TAX_REC           ").Visible = False
    .PivotItems("L_CRED_REINS_3P     ").Visible = False
    End With

    With ActiveCell.PivotTable.PivotFields("Issuer")
    .ClearAllFilters
    .EnableMultiplePageItems = True
    .PivotItems(" ").Visible = False
    End With

    .Range("N9") = "GRID Mapping DvS"
    .Range("O9") = "GRID Name Mapping DvS"
    .Range("P9") = "Country Mapping DvS"
    .Range("Q9") = "Instrument ID DvS added"
    .Range("R9") = "Country Mapping DvS2"
    .Range("R9") = "Thomson-Reuters id"
    .Range("N10:R500").FillDown
    .Calculate

End With
End Sub

1 个答案:

答案 0 :(得分:0)

为了引用数据透视表和数据透视表字段,它应该存在。这部分代码删除了ws3上的所有数据透视表,因此无法进一步引用:

ws3.Cells.Clear
With ws3
    With ActiveCell.PivotTable.PivotFields("GAUDI rubriek")

尝试将您的代码修改为此:

With ws3.Range(ActiveCell.Address).PivotTable.PivotFields("GAUDI rubriek")

ws3ws4的任何地方。因此,您将在相关工作表上引用相关的ActiveCell地址。