A、根据本工作簿的1个表查询求和写法范本
Sub 查询方法一()
Set CONN = CreateObject("ADODB.Connection")
CONN.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
sql = "select 区域,存货类, sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from [sheet4$a:i] where 区域='" & [b3] & "' and month(日期)='" & Month(Range("F3")) & "' group by 区域,存货类"
Sheets("sheet2").[A5].CopyFromRecordset CONN.Execute(sql)
CONN.Close: Set CONN = Nothing
End Sub
Sub 查询方法二()
Set CONN = CreateObject("ADODB.Connection")
CONN.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
sql = "select 区域,存货类, sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from [sheet4$a:i] where 区域='" & [b3] & "' and month(日期)='" & Month(Range("F3")) & "' group by 区域,存货类"
Sheets("sheet2").[A5].CopyFromRecordset CONN.Execute(sql)
CONN.Close: Set CONN = Nothing
End Sub
 
B、根据本工作簿2个表的不同类别查询求和写法范本
Sub 根据入库表和回款表的区域名和月份分别求存货类发货数量和本月回款数量查询()
Set conn = CreateObject("adodb.connection")
conn.Open "provider=microsoft.jet.oledb.4.0;" & _
              "extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
Sheet3.Activate
Sql = " select a.存货类,a.fh ,b.hk from (select 存货类,sum(本月发货数量) " _
       & " as fh from [入库$] where 存货类 is not null and 区域='" & [b2] _
       & "' and month(日期)=" & [d2] & " group by 存货类) as a" _
       & " left join (select 存货类,sum(数量) as hk from [回款$] where 存货类" _
       & " is not null and 区域='" & [b2] & "' and month(开票日期)=" & [d2] & "" _
       & " group by 存货类) as b on a.存货类=b.存货类"
Range("a5").CopyFromRecordset conn.Execute(Sql)
End Sub
 
C、根据本文件夹下其他工作簿1个表区域的区域求和
Sub 在工作表1汇总本文件夹下001工作薄的表1分数列查询汇总()
Set conn = CreateObject("ADODB.Connection")
conn.Open "dsn=excel files;dbq=" & ThisWorkbook.Path & "\001.xls"
sql = "select sum(分数) from [sheet1$]"
Sheets(1).[a2].CopyFromRecordset conn.Execute(sql)
conn.Close: Set conn = Nothing
End Sub
Sub 在工作表1汇总本文件夹下001工作薄的表1A1:A10查询汇总()
Set conn = CreateObject("ADODB.Connection")
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.Path & "\001.xls"
sql = "select sum(f1) from [sheet1$a1:a10]"
Sheets(1).[A5].CopyFromRecordset conn.Execute(sql)
conn.Close: Set conn = Nothing
End Sub
Sub 在工作表1汇总本文件夹下001工作薄的表1分数列A1:A7查询并msgbox表达汇总()
Set conn = CreateObject("ADODB.Connection")
Set rr = CreateObject("ADODB.recordset")
conn.Open "dsn=excel files;dbq=" & ThisWorkbook.Path & "\001.xls"
sql = "select sum(分数) from [sheet1$a1:a7]"
Sheets(1).[A8].CopyFromRecordset conn.Execute(sql)
rr.Open sql, conn, 3, 1, 1
MsgBox rr.fields(0)
conn.Close: Set conn = Nothing
End Sub
 
D、根据本文件夹下其他工作簿多个表区域的单列区域查询求和
sub 本文件夹下其他工作簿的每个工作簿的第4列 30行查询求和
Dim cn As Object, f$, arr&(1 To 30), i%
Application.ScreenUpdating = False
Set cn = CreateObject("adodb.connection")
f = Dir(ThisWorkbook.Path & "\*.xls")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.Path & "\" & f
        Range("d5").CopyFromRecordset cn.Execute("select f4 from [基表1$a5:d65536]")
        cn.Close
            For i = 1 To 30
            arr(i) = arr(i) + Range("d" & i + 4)
        Next i
    End If
    f = Dir
Loop
Range("d5").Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub
 
E、根据本文件夹下其他工作簿多个表区域的多列区域查询求和
sub 本文件夹下其他工作簿的每个工作簿的第B\C\D列 25行查询求和
Dim cn As Object, f$, arr&(1 To 25, 1 To 3), i%
Application.ScreenUpdating = False
Set cn = CreateObject("adodb.connection")
f = Dir(ThisWorkbook.Path & "\*.xls")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;';data source=" & ThisWorkbook.Path & "\" & f
        Range("b6").CopyFromRecordset cn.Execute("select f2,f3,f4 from [基表3$a6:e65536]")
        cn.Close
        For i = 1 To 25
            For j = 1 To 3
                arr(i, j) = arr(i, j) + Cells(i + 5, j + 1)
            Next j
        Next i
    End If
    f = Dir
Loop
Range("b6").Resize(UBound(arr), 3) = arr
Application.ScreenUpdating = True
End Sub