是否可以让自定义的源数据创建数据透视表？

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 

随访

免责声明：我总是测试我的代码发布前，但在没有在当前情况下的文本文件，我无法测试下面的代码。此外，我还没有做任何错误处理，所以如果你有任何错误，让我知道，我们会从那里拿走它。

Button1代码保持不变。我已经稍微更改了第二个按钮代码并添加了第三个按钮。还要注意的是，如果你的数据是说，只有到2000年:)

TIP我没有使用像1048576硬编码的数字没有点考虑所有行考虑：当分发应用程序到您的用户，请记住，包括错误处理。用户通常不会像您期望的那样行事。例如如果用户点击二号按钮点击第一个按钮，或者如果用户点击该按钮3点击第一或第二按钮:)

代码之前什么之前

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

希德

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