在EXCEL中用VBA对ACCESS数据库字段多条件二维筛选求和

rio123

借用“清风明月_dwh”帖子的数据库，需要实现多条件二维表格求和，求好心人帮忙编写下代码！ vba access多条件求和2020.rar (330.33 KB, 下载次数: 1)

2020-3-13 10:38 上传

点击文件名下载附件

原帖地址http://club.excelhome.net/forum.php?mod=viewthread&tid=713211

microyip

将C4：R4作为字段Select，C1:C2、B5:B12作为Where条件就可以啦

microyip

1. Sub 读取数据()
   
2.     Dim oConn As Object, oRS As Object, sSQL As String, sWhere As String
   
3.     Dim vData As Variant, nRow As Long, nCol As Long
   
4.     Dim vDep As Variant, vProj As Variant, dicProj As Object
   
5.    
   
6.     With Sheet2
   
7.         vData = .[C1:C2].Value
   
8.         sWhere = "Where [日期] Between #" & Format(vData(1, 1), "yyyy-mm-dd") & "# And #" & Format(vData(2, 1), "yyyy-mm-dd") & "#"
   
9.         vData = Application.WorksheetFunction.Transpose(.[B5:B12].Value)
   
10.         vData = Replace("'|" & Join(vData, "|") & "|'", "标段费用|", "")
    
11.         sWhere = sWhere & " And (" & vData & " Like '%|'+[科目2]+'|%' Or [科目2] Like '标段费用%')"
    
12.         vProj = .[B5:B12].Value
    
13.         vData = Replace("'|" & Join(Application.WorksheetFunction.Transpose(vProj), "|") & "|'", "标段费用|", "")
    
14.         sWhere = sWhere & " And (" & vData & " Like '%|'+[科目2]+'|%' Or [科目2] Like '标段费用%')"
    
15.         vDep = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(.[C4:R4].Value))
    
16.         vData = "'|" & Join(vDep, "|") & "|'"
    
17.         sWhere = sWhere & " And " & vData & " Like '%|'+[部门]+'|%' "
    
18.         
    
19.         sSQL = "Select IIF([科目2] Like '标段费用%','标段费用',[科目2])"
    
20.         For nRow = 1 To UBound(vDep)
    
21.             sSQL = sSQL & ",Sum(IIf([部门]='" & vDep(nRow) & "',[借方]-[贷方],0)) as " & vDep(nRow)
    
22.         Next
    
23.         sSQL = sSQL & " From [会计分录] " & sWhere & " Group By IIF([科目2] Like '标段费用%','标段费用',[科目2]) "
    
24.         Set oConn = CreateObject("adodb.connection")
    
25.         oConn.Open "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\GWGG.accdb"
    
26.         Set oRS = oConn.Execute(sSQL)
    
27.         If Not (oRS.EOF And oRS.BOF) Then
    
28.             vData = oRS.GetRows
    
29.             Set dicProj = CreateObject("Scripting.Dictionary")
    
30.             For nRow = 0 To UBound(vData, 2)
    
31.                 dicProj(vData(0, nRow)) = nRow
    
32.             Next
    
33.             ReDim Preserve vProj(1 To UBound(vProj), 1 To 1 + UBound(vData))
    
34.             For nRow = 1 To UBound(vProj)
    
35.                 vDep = vProj(nRow, 1)
    
36.                 If dicProj.Exists(vDep) Then
    
37.                     For nCol = 2 To UBound(vProj, 2)
    
38.                         If Not IsNull(vData(nCol - 1, dicProj(vDep))) Then vProj(nRow, nCol) = vData(nCol - 1, dicProj(vDep))
    
39.                     Next
    
40.                 End If
    
41.             Next
    
42.         End If
    
43.         .[B5].Resize(UBound(vProj), UBound(vProj, 2)) = vProj
    
44.         oRS.Close
    
45.         oConn.Close
    
46.         Set oRS = Nothing
    
47.         Set oConn = Nothing
    
48.     End With
    
49. End Sub

复制代码

microyip

附上附件以供参考

rio123

microyip 发表于 2020-3-13 12:09
附上附件以供参考

感谢您的帮忙，我在做表格的时候误把“标段费用（项目部费用）”写成了“标段费用”，变成了模糊查找了，如下图，我把这个改回来了，需要全部都是精确查找，请问怎么修改代码？
麻烦您了！

rio123

microyip 发表于 2020-3-13 12:09
附上附件以供参考

请帮忙看下，非常感谢！