使用If语句VBA刷新具有特定范围的数据透视表

时间:2017-12-08 20:15:45

标签: excel vba excel-vba

目前有以下代码:

    Sub StartReport()
**Dim Month As String**
 Dim Data_sht As Worksheet
 Dim Pivot_sht As Worksheet
 Dim StartPoint As Range
 Dim DataRange As Range
 Dim PivotName As String
 Dim NewRange As String

 ' Set variables equal to data sheet and pivot sheet
 **Set Month = "B2"**

 Set Data_sht = ThisWorkbook.Worksheets.**Month**

 Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report")

 'Enter in Pivot table name
 PivotName = "PivotTable1"

 'Dynamically retrieve range address of data
 Set StartPoint = Data_sht.Range("A1")
 Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
 NewRange = Data_sht.Name & "!" & _
 DataRange.Address(ReferenceStyle:=x1R1C1)

 'make sure every column in data set has a heading and is not blank (error prevention)
 If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
 MsgBox "One of your data columsn has a blank heading." & vbNewLine _
 & "please fix and re-run!.", vbCritical, "Column heading Missing!"
 Exit Sub
 End If

 'Change pivot table data source range address

 Pivot_sht.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)

'Ensure pivot table is refreashed
Pivot_sht.PivotTables("PivotTable1").RefreshTable

'Complete Message
MsgBox PivotName & " 's data source range has been successfully updated!"

End Sub

加粗的部分(在它们之前和之后有**)是我遇到困难的地方。 我希望从我创建的下拉菜单中选取数据,该菜单上有所有选项卡的名称。 下拉位于单元格" B2"在第一个选项卡上。从此下拉列表中选择月份时,我希望选择具有相同名称的数据表作为数据透视表的数据源。 请帮忙

1 个答案:

答案 0 :(得分:0)

以下代码中的详细代码和注释:

go build -o libtest.so -buildmode=c-shared test.go
Option Explicit

Sub StartReport()

Dim PvtTbl As PivotTable
Dim myMonth As String
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim LastRow As Long

' Set variables equal to data sheet and pivot sheet
myMonth = ThisWorkbook.Sheets("Sheet1").Range("B2").Value2  ' <-- modify "Sheet1" to your sheet where you have the Drop-Down

' set the worksheet object according to the month selected
Set Data_sht = ThisWorkbook.Worksheets(myMonth)

Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report")

'Enter in Pivot table name
PivotName = "PivotTable1"

' set the Pivot-Table object
Set PvtTbl = Pivot_sht.PivotTables(PivotName)

'Dynamically retrieve range address of data === Modified ===
With Data_sht
    LastRow = FindLastRow(Data_sht)
    LastCol = FindLastCol(Data_sht)

    Set DataRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

NewRange = DataRange.Address(False, False, xlA1, xlExternal)

'make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountA(DataRange.Rows(1)) < DataRange.Columns.Count Then
    MsgBox "One of your data columns has a blank heading." & vbNewLine _
        & "please fix and re-run!.", vbCritical, "Column heading Missing!"
    Exit Sub
End If

'Change pivot table data source range address

PvtTbl.ChangePivotCache ThisWorkbook.PivotCaches.Create( _
                                    SourceType:=xlDatabase, _
                                    SourceData:=NewRange)

'Ensure pivot table is refreashed
PvtTbl.RefreshTable

'Complete Message
MsgBox PivotName & " 's data source range has been successfully updated!"

End Sub
Function FindLastCol(sht As Worksheet) As Long

' This Function finds the last col in a worksheet, and returns the column number
Dim LastCell As Range

With sht
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                        searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        FindLastCol = LastCell.Column
    Else
        MsgBox "Error! worksheet is empty", vbCritical
    End If
End With

End Function