1

現在のアクティブな選択範囲を、ピボット テーブルのデータ ソースとして参照できる名前付き範囲に変換しようとしています。私の関数 selectByUsedRows は、usedCol 内の行数に基づいて選択を提供し、selectStartCol と selectEndCol で開始および停止します。これは、選択範囲外にある列の行数と一致するセルのみを選択範囲に含めたい場合に便利です。このセレクションに名前を付けるには深みがありません。どんな助けでも素晴らしいでしょう。

エクセルデータ

     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 に答える