Office中国论坛/Access中国论坛

标题: 函数真的卡 求老师用vba 写段代码 [打印本页]
作者: yefeng1019    时间: 2019-12-7 08:53
标题: 函数真的卡 求老师用vba 写段代码
用函数统计数量   多条件求和   

数据一多真的很卡   请老师帮忙用vba写段代码   
万分感谢  
作者: yefeng1019    时间: 2019-12-7 09:11
自己顶一下  不要沉了
作者: roych    时间: 2019-12-9 10:45
看了下，这个鬼大概要写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

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

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


  26. Sub test()
  27.    Dim dict As New Dictionary
  28.    Set dict = getRst("19秋季")
  29.    Sheets("科目数据").Range("C6").Resize(dict.Count, 1) = Application.Transpose(dict.Keys)
  30.    Sheets("科目数据").Range("J6").Resize(dict.Count, 1) = Application.Transpose(dict.Items)
  31. End Sub
复制代码
[attach]63573[/attach]
其它的写法类似，这里就不再写了。这可能需要你花点时间去百度一下SQL语句。




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3