1

我正在尝试将当前活动选择转换为命名范围，我可以将其作为数据透视表的数据源引用。我的函数 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
4

2 回答 2

3

我认为您应该考虑创建一个动态范围，而不是静态范围。像 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
于 2012-09-18T23:06:53.480 回答
2

我假设您正在努力使数据透视表基于“代码工作到这一点”

以下提示输入范围，然后在新工作表上提供基本的数据透视表轮廓

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，是您想要的任何范围，如本例中的提示，或者可以是命名范围、当前选择等。它还假设数据透视表从新工作表的单元格 A1 开始。

于 2012-09-18T22:24:53.853 回答