Excel VBA：活动选择作为数据透视表数据源的命名范围
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12485488/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA: Active Selection as a Named Range for Pivot Table Data Source
提问by Liquidgenius
I am trying to turn the current active selection into a named ranged that I can reference as the data source for a pivot table. My function selectByUsedRows provides a selection based on how many rows are in the usedCol and starting and stoping at selectStartCol and selectEndCol. This is usefull when you only want your selection to contain cells that match the amount of rows of a column that is outside the selection. I am out of my depth on naming the selection on this one. Any help would be great.
我正在尝试将当前活动选择转换为一个命名范围，我可以将其作为数据透视表的数据源引用。我的函数 selectByUsedRows 提供了基于 usedCol 中有多少行以及在 selectStartCol 和 selectEndCol 处开始和停止的选择。当您只希望您的选择包含与选择之外的列的行数相匹配的单元格时，这很有用。我对命名这个选择的深度不够。任何帮助都会很棒。
Excel Data
Excel数据
A B C
1 CaseNum Branch Name
2 1234 APL George
3 2345 VMI George
4 3456 TEX Tom
5 4567 NYC Tom
6 5678 VMI Sam
7 6789 TEX Tom
8 7890 NYC George
VBA
VBA
'Check reference column and select the same number of rows in start and end columns
Sub selectByUsedRows(usedCol As String, selectStartCol As String, selectEndCol As String)
n = Range(usedCol & "1").End(xlDown).Row
Range(selectStartCol & "1:" & selectEndCol & n).Select
End Sub
'Dynamically select columns A to C with as many rows as are in A
Sub test()
refCol = "A"
selectStartCol = "A"
selectEndCol = "C"
selectByUsedRows refCol, selectStartCol, selectEndCol
'Code works until this point. There is now an active selection of A1:C8.
'The following is hypothetical
Dim rngSelection As Range
Set rngSelection = ActiveSelection
Range(rngSourceData).CurrentRegion.Name = "rngSourceData"
Set objTable = Sheet5.PivotTableWizard
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rngSourceData, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet5!R1C4", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
End Sub
回答by Dick Kusleika
I think you should consider creating a dynamic range, rather than a static one. A static range like A1:C8 will populate your pivot table just fine until someone enters more data in RefColumn. If you create a dynamic range like
我认为您应该考虑创建一个动态范围，而不是静态范围。像 A1:C8 这样的静态范围会很好地填充您的数据透视表，直到有人在 RefColumn 中输入更多数据。如果您创建一个动态范围，例如
=$A:INDEX($C:$C,COUNTA($A:$A),1)
Then you won't have to create the pivot table every time the range changes.
这样您就不必在每次范围更改时都创建数据透视表。
Sub MakePT()
Dim sh As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim rUsed As Range
'Make a dynamic range name and return a reference to it
Set rUsed = MakeNamedRange(Sheet1, 1, 1, 3, "rngSourceData")
'Add a new sheet for the pivot table
Set sh = ThisWorkbook.Worksheets.Add
'Create a blank pivot table on the new sheet
Set pc = ThisWorkbook.PivotCaches.Add(xlDatabase, rUsed)
Set pt = pc.CreatePivotTable(sh.Range("A3"), "MyPivot")
End Sub
Public Function MakeNamedRange(sh As Worksheet, lRefCol As Long, lStartCol As Long, lEndCol As Long, sName As String) As Range
Dim sRefersTo As String
Dim nm As Name
'Comments refer to lRefCol = 1, lStartCol = 1, lEndCol = 3
'=$A:
sRefersTo = "=" & sh.Cells(1, lStartCol).Address(True, True) & ":"
'=$A:INDEX($C:$C,
sRefersTo = sRefersTo & "INDEX(" & sh.Cells(1, lEndCol).EntireColumn.Address(True, True) & ","
'=$A:INDEX($C:$C,COUNTA($A:$A),1)
sRefersTo = sRefersTo & "COUNTA(" & sh.Cells(1, lRefCol).EntireColumn.Address(True, True) & "),1)"
Set nm = ThisWorkbook.Names.Add(sName, sRefersTo)
Set MakeNamedRange = sh.Range(sName)
End Function
回答by user3357963
I'm assuming your struggling to get the pivot table working based on 'code works until this point'
我假设您正在努力根据“代码在此之前有效”来使数据透视表正常工作
the following prompts for an input range and then provides a basic pivot table outline on a new sheet
以下提示输入范围，然后在新工作表上提供基本的数据透视表轮廓
Option Explicit
Private Sub someControlOrEvent_Click()
Dim rRange As Range
Dim pTable As Worksheet
On Error Resume Next
Set rRange = Application.InputBox(prompt:= _
"Please select a new data range to name", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
If rRange Is Nothing Then
Exit Sub
Else
'Define Named Range (but not used any further)
ThisWorkbook.Names.Add Name:="MyRange", RefersTo:=rRange
Set pTable = ThisWorkbook.Sheets.Add
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rRange, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=pTable.Range("A1"), TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
End If
End Sub
In this case rRangeis any range you want, a prompt as in this example or could be a named range, current selection etc. It also assume the pivot table starts in cell A1 of a new sheet.
在这种情况下，rRange是您想要的任何范围，如本例中的提示，也可以是命名范围、当前选择等。它还假设数据透视表从新工作表的单元格 A1 开始。
