Возможно ли иметь собственные данные источника для создания сводной таблицы?

Question

Мне было интересно, может ли кто-нибудь помочь мне с этим. Мне нужно создать сводную таблицу с листа, названного «raw». К сожалению, иногда имя рабочего листа может быть другим именем, таким как тест или даже эксперимент.

Мой код выглядит следующим образом, чтобы использовать макрос для создания сводной таблицы.

Range("A1:Z1048576").Select 

Sheets.Add 

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
"raw!R1C1:R1048576C12", Version:=xlPivotTableVersion12 _ 
).CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:= _ 
"PivotTable1", DefaultVersion:=xlPivotTableVersion12 

Как вы можете видеть, мой 'SourceData: = raw', который является именем рабочего листа. Как я уже объяснил ранее, это raw может быть любым именем пользователя, поэтому мне было интересно, можно ли создать сводную таблицу на листе, который имеет имена, которые используют пользователь, который использует макрос, самостоятельно определяя его имя.

Я также попытался с помощью переименования кодирования, но я должен знать имя листа, прежде чем я могу сделать что-нибудь еще ..

Развейте:

Мой GUI имеет открытую и начать кнопку, чтобы начать Все это.

Private Sub testFinder_Click() 
    'Open button 
    Dim fileToOpen 

    fileToOpen = Application _ 
    .GetOpenFilename("Text Files (*.txt), *.txt") 

    If fileToOpen = False Then Exit Sub 

    TextBox1.Value = fileToOpen 
End Sub 

Private Sub CommandButton2_Click() 
    'start button 

    Application.ScreenUpdating = False 

    Workbooks.OpenText Filename:=TextBox1.Value, Origin:=437, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _ 
    , Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
End Sub 

Затем после этого будет кодом для сводной таблицы.

Answer 1

Вы можете использовать ActiveSheet из макросов, но это может дать вам нежелательные результаты, если активный лист не фактический лист, который содержит данные. Вот альтернатива. Почему бы не позволить пользователю выбрать диапазон Pivot? Вы можете использовать этот диапазон в своем коде?

Sub Sample() 
    Dim Rng As Range 

    On Error Resume Next 
    Set Rng = Application.InputBox(Prompt:="Please select the range for the pivot", Type:=8) 
    On Error GoTo 0 

    If Rng Is Nothing Then Exit Sub 

    MsgBox "The Pivot Range is " & Rng.Parent.Name & "!" & Rng.Address 
End Sub 

Followup

ОТКАЗ: Я всегда проверить свой код, прежде чем отправлять, но в отсутствие текстового файла в текущем сценарии, я не могу проверить код ниже. Также я не делал никаких ошибок, поэтому дайте мне знать, если вы получите какие-либо ошибки, и мы их оттуда возьмем.

Button1 Код не изменяется. Я немного изменил код второй кнопки и добавил 3-ей кнопку. Также обратите внимание, что я не я не использую жестко закодированные номера, как 1048576. Нет точки принимая все строки во внимание, если ваши данные говорят только до 2000 :)

TIP: При распространении приложения на пользователя, не забудьте включить ошибку обработки. Пользователи часто не ведут себя так, как вы ожидаете от них.Например, что, если пользователь нажимает на кнопку 2, прежде чем нажать на кнопку 1 или что, если пользователь нажимает на кнопку 3, прежде чем нажать на 1-й или 2-й кнопки :)

КОД

Option Explicit 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
Dim lastRow As Long 

Private Sub CommandButton1_Click() 
    '~~> Remains Unchanged 
End Sub 

'~~> Start button 
Private Sub CommandButton2_Click() 
    Application.ScreenUpdating = False 

    Set wb1 = ThisWorkbook 

    Workbooks.OpenText Filename:=TextBox1.Value, Origin:=437, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
    TrailingMinusNumbers:=True 

    Set wb2 = ActiveWorkbook 
    Set ws2 = Sheets(1) 

    lastRow = ws2.Cells.Find(What:="*", After:=ws2.Range("A1"), _ 
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
End Sub 

'~~> 3rd button Code 
Private Sub CommandButton3_Click() 
    Set ws1 = wb1.Sheets.Add 

    wb1.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    ws2.Name & "!R1C1:R" & lastRow & "C12", Version:=xlPivotTableVersion12 _ 
    ).CreatePivotTable TableDestination:=ws1.Name & "!R3C1", TableName:= _ 
    "PivotTable1", DefaultVersion:=xlPivotTableVersion12 
End Sub 

Followup

испытанный

Option Explicit 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
Dim lastRow As Long, LastCol As Long 
Dim strPath As String, FileName As String 

Private Sub testFinder_Click() 
    '~~> Open button 
    Dim fileToOpen 

    fileToOpen = Application _ 
    .GetOpenFilename("Text Files (*.txt), *.txt") 

    If fileToOpen = False Then Exit Sub 

    TextBox1.Value = fileToOpen 

    FileName = GetFilenameFromPath(TextBox1.Value) 
    strPath = Replace(TextBox1.Value, FileName, "") 
End Sub 

'~~> Start button 
Private Sub CommandButton2_Click() 
    Set wb1 = ThisWorkbook 

    Workbooks.OpenText FileName:=strPath & FileName, Origin:=437, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
    TrailingMinusNumbers:=True 

    Set wb2 = ActiveWorkbook 
    Set ws2 = Sheets(1) 

    lastRow = ws2.Cells.Find(What:="*", After:=ws2.Range("A1"), _ 
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

    LastCol = ws2.Cells.Find(What:="*", After:=ws2.Range("A1"), _ 
    Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _ 
    SearchDirection:=xlPrevious, MatchCase:=False).Column 
End Sub 

'~~> 3rd button Code 
Private Sub CommandButton3_Click() 
    Set ws1 = wb2.Sheets.Add 

    wb2.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    ws2.Name & "!R1C1:R" & lastRow & "C" & LastCol, _ 
    Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:= _ 
    "[" & wb2.Name & "]" & ws1.Name & "!R3C1", _ 
    TableName:="PivotTable1", DefaultVersion:= _ 
    xlPivotTableVersion12 
End Sub 

Public Function GetFilenameFromPath(ByVal strPath As String) As String 
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then 
     GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, _ 
     Len(strPath) - 1)) + Right$(strPath, 1) 
    End If 
End Function 

НТН

Sid

Answer 2

Название текущего листа доступно через activesheet.name.

SourceData:= activesheet.name & "!R1C1:R1048576C12" 

Answer 3

Вы могли бы попробовать что-то вроде:

Sub AddPivot() 

Dim shName As String 
Dim shNames As String 
Dim strFullRng As String 
Dim wks As Worksheet 
Dim blPresent As Boolean 

For Each wks In ThisWorkbook.Sheets 
    shNames = shNames & UCase(wks.Name) & "|" 
Next wks 


Do 
    shName = InputBox("Please enter the sheetname", "Create Pivot") 

    If InStr(1, shNames, UCase(shName)) > 0 Then 
     blPresent = True 
    Else 
     MsgBox ("That sheet name is invalid") 
    End If 

Loop Until blPresent 

Set wks = Sheets.Add 

strFullRng = shName & "!" & Sheets(shName).Cells(1, 1).CurrentRegion.Address 
ThisWorkbook.PivotCaches.Add(xlDatabase, strFullRng).CreatePivotTable wks.Cells(3, 1), "PivotTable1" 


End Sub