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

Question

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

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

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 может быть любым именем самого пользователя, поэтому мне было интересно, возможно ли создать сводную таблицу из листа, имена которого, который пользователь использует макрос, самостоятельно определили его имя.

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

Продолжение:

Мой графический интерфейс пользователя открыт иКнопка запуска, чтобы начать все это.

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 остается без изменений.Я немного изменил код 2-й кнопки и добавил 3-ю кнопку.Также обратите внимание, что я не использую жестко закодированные числа, такие как 1048576. Нет смысла принимать во внимание все строки, если ваши данные говорят только до 2000 года:)

СОВЕТ : При распространении приложения на вашпользователь, не забудьте включить обработку ошибок.Пользователи часто ведут себя не так, как вы ожидаете от них.Например, что если пользователь нажимает на 2-ю кнопку до нажатия на 1-ю кнопку ИЛИ что если пользователь нажимает на 3-ю кнопку до нажатия на 1-ю или 2-ю кнопку:)

CODE

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

СЛЕДОВАТЬ

ПРОВЕРЕНО И ИСПЫТАНО

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

HTH

Sid

Answer 2

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

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

Answer 3

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

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