是否可以使用自定义源数据来创建数据透视表?

时间:2012-03-01 13:40:17

标签: vba excel-vba excel

我想知道是否有人可以帮助我。我必须从名为“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可以是用户自己的任何名称,所以我想知道是否可以从工作表创建一个数据透视表,该工作表的名称是用户使用宏,自定义其名称。 / p>

我也尝试过使用重命名编码,但我必须先了解工作表名称,然后才能做其他事情。

跟进:

我的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

然后,将成为数据透视表的代码。

3 个答案:

答案 0 :(得分:4)

您可以使用宏中的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代码保持不变。我稍微更改了第二个按钮代码并添加了第3个按钮。另请注意,我没有使用像1048576这样的硬编码数字。如果您的数据仅在2000年之前说明,则不考虑所有行:)

提示:将应用程序分发给用户时,请记住包含错误处理。用户通常不会像您期望的那样表现。例如,如果用户在单击第一个按钮之前单击第二个按钮,或者如果用户在单击第一个或第二个按钮之前单击第三个按钮,该怎么办?)

<强> 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

西特

答案 1 :(得分:0)

当前工作表的名称可通过activesheet.name获得。

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

答案 2 :(得分:0)

您可以尝试以下方式:

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