使用If语句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 粗体的部分（前后有**）是我遇到困难的地方。 我想要从我创build的下拉菜单中选取数据，其中包含所有选项卡的名称。 下拉列表位于第一个选项卡上的单元格“B2”中。 当从这个下拉列表中select一个月时，我希望select具有相同名称的数据表作为数据透视表的数据源。 请帮忙
下面的代码中的详细代码和评论：
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
Function FindLastRow(sht As Worksheet) As Long ' This Function finds the last row in a worksheet, and returns the row number Dim LastCell As Range With sht Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _ searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False) If Not LastCell Is Nothing Then FindLastRow = LastCell.Row Else MsgBox "Error! worksheet is empty", vbCritical End If End With End Function