ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1194|回复: 2

[分享] 查询access数据库的数据的记录集做为数据透视表的数据源

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-30 15:56 | 显示全部楼层 |阅读模式
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") = "姓名"
   

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 15:57 | 显示全部楼层
本帖最后由 ranger丶亦 于 2020-1-30 16:58 编辑

   iCol = wks.Cells(2, Columns.Count).End(xlToLeft).Column
   iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row
   wks.Range(wks.Cells(2, 2), wks.Cells(2, iCol)).NumberFormatLocal = "m月d日"
   
   With wks.Range(wks.Cells(2, 1), wks.Cells(iRow, iCol))
      With .Borders
         .LineStyle = xlContinuous
         .Weight = xlHairline
      End With
      With .Font
         .Name = "宋体"
         .Size = 11
      End With
   End With
   For i = iCol To 4 Step -2
     wks.Columns(i).NumberFormatLocal = "0.00"
   Next i
   
   wks.Range("1:1").Interior.ColorIndex = 2
   wks.Range("a3").CurrentRegion.HorizontalAlignment = xlCenter
   If iCol < 27 Then
      wks.Columns("A:" & Chr(iCol + 64)).AutoFit
   ElseIf iCol < 53 Then
      wks.Columns("A:A" & Chr(iCol + 64 - 26 * 1)).AutoFit
   ElseIf iCol < 79 Then
      wks.Columns("A:B" & Chr(iCol + 64 - 26 * 2)).AutoFit
   ElseIf iCol < 105 Then
      wks.Columns("A:C" & Chr(iCol + 64 - 26 * 3)).AutoFit
   ElseIf iCol < 131 Then
      wks.Columns("A:D" & Chr(iCol + 64 - 26 * 4)).AutoFit
   ElseIf iCol < 157 Then
      wks.Columns("A:E" & Chr(iCol + 64 - 26 * 5)).AutoFit
   ElseIf iCol < 183 Then
      wks.Columns("A:F" & Chr(iCol + 64 - 26 * 6)).AutoFit
   ElseIf iCol < 209 Then
      wks.Columns("A:G" & Chr(iCol + 64 - 26 * 7)).AutoFit
   ElseIf iCol < 235 Then
      wks.Columns("A:H" & Chr(iCol + 64 - 26 * 8)).AutoFit
   End If
   
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 16:05 | 显示全部楼层
本帖最后由 ranger丶亦 于 2020-1-30 16:57 编辑

一次发不完。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 18:33 , Processed in 0.043632 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表