Excel VBA : Active Selection as a Named Range for Pivot Table Data Source

Question

我正在尝试将当前事件选择转换为命名范围，我可以将其作为数据透视表的数据源引用。我的函数 selectByUsedRows 提供了基于 usedCol 中有多少行以及在 selectStartCol 和 selectEndCol 处开始和停止的选择。当您只希望您的选择包含与选择之外的列的行数匹配的单元格时，这很有用。我无法为这个选择命名。任何帮助都会很棒。

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

'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

我认为您应该考虑创建一个动态范围，而不是静态范围。像 A1:C8 这样的静态范围将很好地填充您的数据透视表，直到有人在 RefColumn 中输入更多数据。如果您创建一个动态范围，例如

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

这样您就不必在每次范围更改时都创建数据透视表。

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