威爾遜,
我相信這將會回答你的問題。我有一個類似的問題,並設法實現一個解決方案,當然你需要根據你的具體需求調整代碼(或者僱用我)。
我花了差不多半天的時間來完成和記錄這個例子,所以請在提問前仔細閱讀代碼註釋。
由於您沒有提供Excel示例,我盡我最大的努力模擬了您擁有的文件並瞭解其目的。有幾個步驟來完成你想要的,也許最重要的(並且首先難以獲得)是動態範圍。如果您有任何疑問,請仔細閱讀代碼註釋和源代碼。
您需要設置一個動態範圍並將該範圍用作創建數據透視表的參考(說起來容易做起來難)。祝你好運,讓我知道這是否有助於你。
工作實例可以在這裏下載表格: https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm
下面是該項目創建的代碼:
Option Explicit
Public Sub DynamicRange()
'---------------------------------------------------------------------------------------
' Method : DynamicRange
' Author : vicsar
' Date : 6/15/2016
' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation
' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel
' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office)
' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand
' how the dinamic range works
' Working example can be downloaded form here:
' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm
'---------------------------------------------------------------------------------------
On Error GoTo MistHandler
' Let's begin by handling posible human errors
' Check if the RawData sheet exists, if it doesn't then warn the user
If WorksheetExists("RawData") = False Then
MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _
& Chr$(13) _
& Chr$(13) _
& "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says"
Exit Sub
End If
' Check if the PivotReport sheet exists, if it does then warn the user
If WorksheetExists("PivotReport") = True Then
MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says"
Exit Sub
End If
' Using this will make the procedure run faster. You won't be able to see what the macro is doing,
' but it will run faster, specially beneficial when you have thousands of rows.
Application.ScreenUpdating = False
' Aesthetics
Sheets("RawData").Select
ActiveWindow.DisplayGridlines = False
With ActiveWorkbook.Sheets("RawData").Tab
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0
End With
' Let's begin by creatign a dynamic reference for the pivot report
' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand.
' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box,
' to select the range on the worksheet.
' If the Named Data Range exist it will be re-writen
' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))
ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _
"=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))"
ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand."
' Add destination sheet for the pivot table
Worksheets.Add().Name = "PivotReport"
Sheets("PivotReport").Select
' This example shows how to add a pivot table based on the dynamic range.
' You will have to manually arrange the PivotTable fields
'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
' "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _
' TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _
' DefaultVersion:=xlPivotTableVersion15
'Sheets("PivotReport").Select
'Cells(1, 1).Select
' This example shows how to add a pivot table based on the dynamic range.
' The PivotTable fields are set for the user
'
' Inserting the Pivot Table
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _
DefaultVersion:=xlPivotTableVersion15
Sheets("PivotReport").Select
Cells(1, 1).Select
' Defining the PivotTable fields
' Adding fields to the ROWS area
With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields(_
"Reconciled?")
.Orientation = xlRowField
.Position = 1
End With
' Adding fields to the VALUES area
ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _
PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _
xlSum
' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use
' the same field on the ROWS and VALUES areas
With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount")
.Orientation = xlRowField
.Position = 2
End With
' Refreshing the Pivot Table cache
ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh
' Moar Aesthetics
With ActiveWorkbook.Sheets("PivotReport").Tab
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
End With
ActiveWindow.DisplayGridlines = False
' Allowing screen updates again
Application.ScreenUpdating = True
MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says"
On Error GoTo 0
Exit Sub
MistHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says"
End Sub
Public Function WorksheetExists(ByVal strWorksheetName As String) As Boolean
'---------------------------------------------------------------------------------------
' Method : WorksheetExists
' Author : vicsar
' Date : 6/16/2016
' Purpose: Boolean - Checks if a worksheet exists
'---------------------------------------------------------------------------------------
On Error GoTo MistHandler
Dim objSheet As Worksheet
For Each objSheet In ThisWorkbook.Worksheets
If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then
WorksheetExists = True
Exit Function
End If
Next objSheet
WorksheetExists = False
On Error GoTo 0
Exit Function
MistHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says"
End Function
不能只要運行'評估(「MATCH(MAX(B: B),B:B,0)「)'得到最後使用的行(假設最低的值是最高的)? –
謝謝,德克。我試圖找出編輯。 –
我想在所有支票上做一個數據透視表,但支票的數量從不相同。 –