Excel的VBA：主動選擇的命名範圍透視表數據源

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 

Answer 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開始。