我正在制作一个excel项目，用户将选择日期并填充服务器/数据库名称，数据将填入Excel工作簿中已包含正确列名称的工作表中。现在将创建两个工作表（填充sql数据）和我想要创建的每个工作表的轴。这是prod命名表的第一个宏
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
现在数据已成功填充到Prod和Test表中。下一个宏来创建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"
同样适用于测试表。
@ lopsided-在您的代码文件中，您正在创建新工作表以从sql db获取数据。但是我应该在哪里以及如何将我的prod和测试表连接到缓存以使它们成为枢轴源？我的意思是在你的方法中，如果我调用宏prod（）或Test（）来获取我们在这里添加的名为report的工作表中的数据。那么在那种情况下我们怎么能继续前进呢？ 在上面的代码我在pivotcache.add代码行中收到错误。这似乎是一个小小的改变，请看看你是否可以进行修正。
答案 0 :(得分：1)
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
您的字段定义看起来正确，因此这会让您超越数据透视表问题，这无疑会带您进入下一个数据透视表问题。
如需其他帮助，请参阅以下链接：
此外，这是一个完整的工作示例，使用我所做的项目中的数据透视表来格式化和过滤信用卡收据：
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：回应......
@ lopsided-在您的代码文件中，您正在创建新工作表以获取数据 来自sql db。但我应该在哪里以及如何连接我的产品和测试表 缓存以使它们成为枢轴源？
我的数据透视表源会引用我的报告工作表变量中使用的范围。在我给你的代码中，我的SQL数据位于我们分配给 Report 工作表变量的新工作表中。在您的代码中，您的SQL数据位于名为“UserInput”的现有工作表中，您忽略了将其分配给变量（坏习惯）。 要让我的代码与您的代码一起工作，您需要做的就是更改报表变量的值。
换句话说，改变这个：
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.