2

我正在制作一个 excel 项目，用户将在其中选择日期并填写服务器/数据库名称，数据将从该名称填充到 Excel 工作簿中已经存在的具有正确列名的工作表中。现在将创建两个工作表（填充 sql 数据）和我要创建的每个工作表的枢轴。这是名为 sheet 的产品的第一个宏

Sub Prod()
ActiveWorkbook.Sheets("UserInput").Activate ' a sheet where date picker and db/server names are taken from user
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim slctqry As String
Dim dealdate As String
Dim today As String
Dim msg As String
msg = "Sorry, for this date data is yet to come"
today = Range("B2").Value  'B2 cell has today() function
today = Format(today, "yyyy-mm-dd")
dealdate = Range("B1").Value 'date picker is linked to this cell
dealdate = Format(dealdate, "yyyy-mm-dd")
con.ConnectionString = "Provider=SQLOLEDB;Data Source=sql123abce\sql01;Initial Catalog=sqldb;User ID=abcd;Password=Windows;Integrated Security=SSPI"
con.Open
If (dealdate > today) Then
MsgBox msg
ElseIf (dealdate = today) Then
slctqry = "select Number,Premium, TransactionID, money from traders(nolock)"
slctqry = slctqry & " where convert(date,tradedate,103)='" & dealdate & "'"
Set rs.ActiveConnection = con
rs.Open slctqry
ActiveWorkbok.Sheets("Prod").Activate ' prod named worksheet where data will be copied from SQL db
Range("A2").CopyFromRecordset (rs)
ElseIf (dealdate < today) Then
slctqry = "select Number,Premium, TransactionID, money from tradersaudit(nolock)"
slctqry = slctqry & " where convert(date,tradedate,103)='" & dealdate & "'"
Set rs.ActiveConnection = con
rs.Open slctqry
'Dim ws4 As Worksheet
ActiveWorkbook.Sheets("Prod").Activate
Range("A2").CopyFromRecordset (rs)
End If
con.Close
End Sub

对于从用户获取的 db/server 和数据将填写在名为 Test 的工作表中，使用的宏是

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset


Function GetConnectionString() As String

   Dim strCn As String
    strCn = "Provider=sqloledb;"
    strCn = strCn & "Data Source=" & Range("Server") & ";"
    strCn = strCn & "Initial Catalog=" & Range("Database") & ";"
    If (Range("UserID") <> "") Then
        strCn = strCn & "User ID=" & Range("UserID") & ";"
        strCn = strCn & "password=" & Range("Pass")
    Else
        strCn = strCn & "Integrated Security = SSPI"
    End If

    GetConnectionString = strCn

End Function

Sub Test()

ActiveWorkbook.Sheets("UserInput").Activate
Dim ws As Worksheet
Dim Sql As String
Dim dealdate As String
Dim today As String
Dim msg As String
msg = "Sorry, for this date data is yet to come"
today = Range("B2").Value
today = Format(today, "yyyy-mm-dd")
dealdate = Range("B1").Value
dealdate = Format(dealdate, "yyyy-mm-dd")
' open connection
cn.ConnectionTimeout = 100
cn.Open GetConnectionString()
If (dealdate > today) Then
MsgBox msg
ElseIf (dealdate = today) Then
Sql = "select Number,Premium, TransactionID, money from traders(nolock)"
Sql = Sql & " where convert(date,tradedate,103)='" & dealdate & "'"
Set rs.ActiveConnection = con
rs.Open Sql
ActiveWorkbook.Sheets("Test").Activate ' test sheet is there alerady with proper column  names
Range("A2").CopyFromRecordset rs
ElseIf (dealdate < today) Then
Sql = "select Number,Premium, TransactionID, money from traders(nolock)"
Sql = Sql & " where convert(date,tradedate,103)='" & dealdate & "'"
Set rs.ActiveConnection = cn
rs.Open Sql
ActiveWorkbook.Sheets("Test").Activate
Range("A2").CopyFromRecordset rs
End If
cn.Close
End Sub

现在数据已成功填充到工作表和测试表中。下一个宏用于创建 Pivot。

 Dim bReport As Workbook, Report As Worksheet, pivotSheet As Worksheet 'To set up my workbook & worksheet variables.

    Set bReport = Excel.ActiveWorkbook
    Set Report = bReport.Worksheets.Add 'Create the worksheet to place the SQL data
    Set pivotSheet = bReport.Worksheets.Add 'Create the worksheet to place the Pivot Table

    Dim pivotSource As Range 'To set up the variable representing your pivot data.
    Set pivotSource = Report.UsedRange 'You can define a specific range, but this assumes the data is the only thing on the Report sheet.

    Dim tableName As String
    tableName = "Pivot_Prod"  'name of pivot report i wanted to create from data in sheet Prod

    bReport.PivotCaches.Add(SourceType:=xlDatabase, _
            SourceData:=pivotSource).CreatePivotTable TableDestination:=pivotSheet.Cells(1, 1), _
                tableName:=tableName

    Set pt = pivotSheet.PivotTables(tableName)
    pivotSheet.PivotTableWizard TableDestination:=pivotSheet.Cells(1, 1)
    Set pOne= pt.PivotFields("Number")
    Set pTwo = pt.PivotFields("Premium")
    Set pthree = pt.PivotFields("TransactoinID")
    Set pFour = pt.PivotFields("money")

    pOne.Orientation = xlRowField 'This assigns the orientation of a given field to xlRowField.
    pTwo.Orientation = xlRowField
    pTwo.Subtotals(1) = False 'This denotes there will be no subtotal for this field.
    pThree.Orientation = xlRowField
    pThree.Subtotals(1) = False
    pFour.Orientation = xlDataField
    pFour.NumberFormat = "$#,##0.00"

测试表也一样。

@loplateral-在您的代码文件中，您正在创建新工作表以从 sql db 获取数据。但是我应该在哪里以及如何将我的产品和测试表链接到缓存以使它们成为枢轴源？我的意思是在你的方法中，如果我调用宏 prod() 或 Test() 来获取我们在此处添加的名为 report 的工作表中的数据。那么在那种情况下我们怎么能继续呢？在上面的代码中，我在 pivotcache.add 代码行中遇到错误。好像需要小改动，看看能不能改正。

4

1 回答 1

2

TBH，VBA 中的数据透视表真的很痛苦。不久前，我决定将它们用于一些项目，并且从那以后一直避免使用它们。为您的代码实现数据透视缓存的正确方法如下：

'First, define the range that includes your source data. This would be the data you pulled from SQL, and presumably inserted into a different sheet using CopyFromRecordset. 
'NOTE: If you have not copied the data from the recordset onto a worksheet, visit the links in this post to find out how.
'Also note, I always define the workbooks and worksheets I will be using in a project, and then reference them via their variables. This makes my code less error prone, I find.

Dim bReport As Workbook, Report As Worksheet, pivotSheet As Worksheet 'To set up my workbook & worksheet variables.

Set bReport = Excel.ActiveWorkbook
Set Report = bReport.Worksheets.Add 'Create the worksheet to place the SQL data
Set pivotSheet = bReport.Worksheets.Add 'Create the worksheet to place the Pivot Table

'******************************************************************************************************************
'Here you will insert your SQL data into the Report worksheet to be used as the source of the Pivot Table data.
'   ....Your code here....
'******************************************************************************************************************

Dim pivotSource As Range 'To set up the variable representing your pivot data.
Set pivotSource = Report.UsedRange 'You can define a specific range, but this assumes the data is the only thing on the Report sheet.

'Next you will decide on the name of the Pivot Table
Dim tableName As String
tableName = "Poll Table"

'Now here is what you've been waiting for...the ever-elusive PivotCaches method.
bReport.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=pivotSource).CreatePivotTable TableDestination:=pivotSheet.Cells(1, 1), _
            tableName:=tableName

Set pt = pivotSheet.PivotTables(tableName) 'Set a Pivot Table variable to our new Pivot Table    
pivotSheet.PivotTableWizard TableDestination:=pivotSheet.Cells(1, 1) 'Place the Pivot Table to Start from A1 on the new sheet

您的字段定义看起来正确，因此这应该可以帮助您解决 PivotCaches 问题，这无疑会将您带到下一个 Pivot Tables 问题。

如需其他帮助，请参阅以下链接：

此外，这是一个使用我所做的项目中的数据透视表来格式化和过滤信用卡收据的完整工作示例：

Sub amexTable()

Dim i As Integer, k As Integer, j As Integer
Dim Report As Worksheet, reportBook As Workbook, pivotSheet As Worksheet
Dim Row As Range, Col As Range, pivotSrc As Range, pivotDest As Range

Set Report = Excel.ActiveSheet
Set reportBook = Report.Parent
Set pivotSheet = reportBook.Worksheets.Add
pivotSheet.Name = "Amex Pivot Table"

'************************************
'Declare variables for pivot headers
'************************************
Dim pDate As PivotField, pDesc As PivotField, _
pCardmember As PivotField, pAccount As PivotField, pAmount As PivotField
Dim pGL As PivotField
Dim Table_Name As String
Dim pt As PivotTable

'*******************************
'Declare and create pivot table
'*******************************
Table_Name = "Amex Pivot Table"
Set pivotSrc = Report.Range("A7:F" & Report.UsedRange.Rows.Count)

reportBook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=pivotSrc).CreatePivotTable TableDestination:=pivotSheet.Cells(1, 1), _
            TableName:=Table_Name

    Set pt = pivotSheet.PivotTables(Table_Name) 'Set a Pivot Table variable to our new Pivot Table


    pivotSheet.PivotTableWizard TableDestination:=pivotSheet.Cells(1, 1) 'Place the Pivot Table to Start from A1 on the new sheet

    Set pCardmember = pt.PivotFields("Cardmember")
    Set pAccount = pt.PivotFields("Account #")
    Set pDate = pt.PivotFields("Date")
    Set pDesc = pt.PivotFields("Description")
    Set pAmount = pt.PivotFields("Amount")



    pCardmember.Orientation = xlRowField 'This assigns the orientation of a given field to xlRowField.
    pDate.Orientation = xlRowField
    pDate.Subtotals(1) = False 'This denotes there will be no subtotal for this field.
    pDesc.Orientation = xlRowField
    pDesc.Subtotals(1) = False
    pAccount.Orientation = xlRowField
    pAmount.Orientation = xlDataField
    pAmount.NumberFormat = "$#,##0.00"
    pt.SortUsingCustomLists = True 'Sets the pivot table to use a custom sorting list as described in the link below:

    '   Excel Pivot Tables: Sort Fields, Values & Dates, use Custom Lists, with VBA
    '   http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=148:excel-pivot-tables-sort-fields-values-a-dates-use-custom-lists-with-vba&catid=79&Itemid=475

    pivotSheet.Columns.AutoFit
    pivotSheet.Cells(1, 1).EntireRow.Insert
    pivotSheet.Range("A1:E1").Merge
    pivotSheet.Cells(1, 1).HorizontalAlignment = xlCenter
    pivotSheet.Cells(1, 1).Value = "AMEX Pivot Table" 'Header'

    Application.Run myColor(pivotSheet.Cells(1, 1), "blueHeader") 'My custom function to format the header.

    Application.Run Alternate_Row_Colors(3, pivotSheet) 'My custom function to format alternating row colors.

End Sub

最后一点...出于调试目的，此代码应放置在模块中，而不是 ThisWorkbook 中。

更新

@Honey：回应...

@loplateral-在您的代码文件中，您正在创建新工作表以从 sql db 获取数据。但是我应该在哪里以及如何将我的产品和测试表链接到缓存以使它们成为枢轴源？

我的数据透视表源引用了我的报告工作表变量中使用的范围。在我给您的代码中，我的 SQL 数据位于我们分配给此报告工作表变量的新工作表中。在您的代码中，您的 SQL 数据位于名为“UserInput”的现有工作表中，您忽略了将其分配给变量（坏习惯）。要使我的代码与您的代码一起使用，您需要做的就是更改 Report 变量的值。

换句话说，改变这个：

Set Report = bReport.Worksheets.Add 'Create the worksheet to place the SQL data

对此：

Set Report = bReport.Worksheets("UserInput") 'Assign your data worksheet to the Report worksheet variable.
于 2013-04-16T14:35:15.593 回答