设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1856|回复: 2

函数真的卡 求老师用vba 写段代码

[复制链接]
发表于 2019-12-7 08:53:59 | 显示全部楼层 |阅读模式
用函数统计数量   多条件求和   

数据一多真的很卡   请老师帮忙用vba写段代码   
万分感谢  

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
 楼主| 发表于 2019-12-7 09:11:26 | 显示全部楼层
自己顶一下  不要沉了
发表于 2019-12-9 10:45:02 | 显示全部楼层
看了下,这个鬼大概要写ado,晚上再说吧。
  1. Function getRst(ByVal strWhere As String) As Dictionary
  2.     Dim cnn As New ADODB.Connection
  3.     Dim rst As New ADODB.Recordset
  4.     Dim dict As New Dictionary
  5.     Dim strSQL As String
  6.     Application.ScreenUpdating = False

  7.    
  8.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='excel 12.0;hdr=yes';Data Source=" & ThisWorkbook.FullName
  9.     strSQL = "select 科目,sum(实际收费) as 收费合计 from [学员档案汇总$A2:AI699] where 季度='" & strWhere & "' group by 科目"
  10.     rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

  11.     Do Until rst.EOF
  12.         dict.Add rst(0).Value, rst(1).Value
  13.         rst.MoveNext
  14.     Loop
  15.    
  16.     Set getRst = dict
  17.     Set dict = Nothing
  18.     rst.Close
  19.     cnn.Close
  20.       
  21. End Function


  22. Sub test()
  23.    Dim dict As New Dictionary
  24.    Set dict = getRst("19秋季")
  25.    Sheets("科目数据").Range("C6").Resize(dict.Count, 1) = Application.Transpose(dict.Keys)
  26.    Sheets("科目数据").Range("J6").Resize(dict.Count, 1) = Application.Transpose(dict.Items)
  27. End Sub
复制代码

其它的写法类似,这里就不再写了。这可能需要你花点时间去百度一下SQL语句。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-3-29 20:42 , Processed in 0.083233 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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