我正在尝试在Excel中设置一个宏，它将为数据透视表选择一个范围。唯一的问题是范围永远不会相同。这一切都取决于已经写了多少支票。我希望它的工作方式是按CTRL向下箭头然后再回来两次以开始选择。然后从那里转移到列f然后控制向上以选择范围。这是我想要在数据透视表中的数据的屏幕截图。宏的代码低于数据。
Bank Account
Checks Check Number Date Amount Reterence Reconciled?
2002 6/3/2016 -20.00 Fred C
2003 6/3/2016 -30.00 George N
2004 6/3/2016 -40.00 Sue N
2005 6/3/2016 -50.00 Greg C
2006 6/3/2016 -10.00 McDonalds C
2007 6/3/2016 -20.00 Wendys N
2008 6/3/2016 -30.00 KFC C
2009 6/3/2016 -40.00 WalMart C
2006 6/3/2016 -50.00 Kmart C
2007 6/3/2016 -60.00 Kroger N
2008 6/3/2016 -70.00 Dollar General N
2009 6/3/2016 -80.00 Sears C
Check Total -$500.00
Deposits
11/3/2014 50.00 Deposit Y
11/3/2014 60.00 Deposit Y
11/3/2014 70.00 Deposit Y
11/3/2014 80.00 Deposit Y
11/3/2014 10.00 Deposit Y
11/3/2014 20.00 Deposit Y
11/3/2014 30.00 Deposit Y
代码：
Range("A4").Select
Selection.End(xlDown).Select
Range("A4").Select
Selection.End(xlDown).Select
Range("A15").Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R3C1:R15C6", Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="Sheet2!R3C1", TableName:="PivotTable3", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Sheet2").Select
Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Amount"), "Sum of Amount", xlSum
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Reconciled?")
.Orientation = xlRowField
.Position = 1
End With
Range("D3").Select
答案 0 :(得分：0)
威尔逊，
我相信这会回答你的问题。我有一段时间遇到过类似的问题并设法实现解决方案，当然你需要根据你的特定需求调整代码（或雇用我）。
我花了将近半天的时间来完成并记录这个例子，所以，请务必仔细阅读代码注释，然后再询问。
由于您没有提供Excel示例，我尽力模仿您拥有的文件并了解其用途。有几个步骤可以实现您想要的，也许最关键的（并且最难获得 - 起初）是动态范围。如果您有任何疑问，请仔细阅读代码注释和源材料。
您需要设置动态范围并使用该范围作为创建数据透视表的参考（说起来容易做起来难）。祝你好运，如果这有助于你，请告诉我。
以下是为此项目创建的代码：
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