Excel VBA：活动select作为数据透视表数据源的命名范围

我正在尝试将当前的活动select转换为我可以引用为数据透视表的数据源的命名范围。 我的函数selectByUsedRows提供了一个select，基于usedCol中的行数以及在selectStartCol和selectEndCol处开始和停止。 当您只希望您的select包含与选定范围外的列的行数相匹配的单元格时，这是有用的。 我在这个名字的select上没有深入。 任何帮助将是伟大的。

Excel数据

ABC 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

 '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 

Answer 1

我认为你应该考虑创build一个dynamic范围，而不是一个静态的范围。 像A1：C8这样的静态范围将会填充数据透视表，直到有人在RefColumn中input更多的数据为止。 如果你创build一个dynamic范围

 =$A$1:INDEX($C:$C,COUNTA($A:$A),1) 

然后，每次范围更改时都不必创build数据透视表。

 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$2: sRefersTo = "=" & sh.Cells(1, lStartCol).Address(True, True) & ":" '=$A$2:INDEX($C:$C, sRefersTo = sRefersTo & "INDEX(" & sh.Cells(1, lEndCol).EntireColumn.Address(True, True) & "," '=$A$2: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 

Answer 2

我假设你努力获得数据透视表工作的基础上的代码作品，直到这一点“

以下提示input范围，然后在新工作表上提供基本的数据透视表大纲

 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 

在这种情况下， rRange是你想要的任何范围，如本例中的提示，或者可以是命名范围，当前select等等。它还假定数据透视表在新表的单元格A1中开始。