|
Sub 查询指定日期内的赠送明细数据()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim i As Integer
Dim SQL As String
Dim d1 As Date, d2 As Date
Set wsh = Sheets("部门主营")
d1 = wsh.Range("j2").Value
d2 = wsh.Range("k2").Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cnn
.Provider = "Microsoft.ace.oledb.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\XX店2020数据库.accdb"
.Open
End With
SQL = "select * from 赠送明细表 where 帐务日期 between #" & d1 & "# and #" & d2 & "#"
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
Sheets("赠送汇总表").Delete
Sheets.Add(before:=Sheets("消费出品明细")).Name = "赠送汇总表"
Set wsh = Sheets("赠送汇总表")
Set PTCache = ThisWorkbook.PivotCaches.Create(xlExternal)
Set PTCache.Recordset = rs
Set PT = PTCache.CreatePivotTable(tabledestination:=wsh.Range("A1"), TableName:="zshz")
With PT
With .PivotFields("赠送人")
.Orientation = xlRowField
.Caption = "姓名"
End With
With .PivotFields("职位权限")
.Orientation = xlRowField
.Caption = "权限"
End With
.PivotFields("帐务日期").Orientation = xlColumnField
With .PivotFields("金额")
.Orientation = xlDataField
.Function = xlSum
.Caption = "赠送金额"
End With
With .PivotFields("赠送成本合计")
.Orientation = xlDataField
.Function = xlSum
.Caption = "赠送成本"
End With
End With
With ActiveSheet.PivotTables("zshz")
.TableStyle2 = "PivotStyleMedium13"
.MergeLabels = True
.ShowDrillIndicators = False
With .PivotFields("姓名")
.LayoutForm = xlTabular
.Subtotals = Array(False, False, False, False, False, False, _
False, False, False, False, False, False)
End With
With .PivotFields("权限")
.LayoutForm = xlTabular
.Subtotals = Array(False, False, False, False, False, False, _
False, False, False, False, False, False)
End With
End With
Set wks = Sheets("赠送汇总表")
wks.Range("c1") = ""
wks.Range("a3") = "姓名"
|
|