Conn.Open \properties='excel 8.0;hdr=no';data source=\
Sql = \ Cells.Clear
[a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close
Set Conn = Nothing End Sub
Private Sub CommandButton1_Click()
'要求从“数据.xlt”中获取Sheet1.range(\中的数据，并赋给一变量 Dim Sql$, Conn, rs, str1
Set Conn = CreateObject(\ Set rs = CreateObject(\
Conn.Open \properties='excel 8.0;hdr=no';data source=\数据.xlt\
Sql = \ rs.Open (Sql), Conn, 1, 1 aa = rs.getrows str1 = aa(0, 0) MsgBox str1 Conn.Close
Set Conn = Nothing End Sub
7，计算 A1+B1
'计算 A1+B1 Sub A1_Plus_b1() Dim Sql$
Set Conn = CreateObject(\
Conn.Open \properties='excel 8.0;hdr=no';data source=\
Sql = \ Cells.Clear
[a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close
Set Conn = Nothing End Sub
8，计算 A1+A2
'计算 A1+A2 Sub sumcolumn() Dim Sql$
Set Conn = CreateObject(\
Conn.Open \properties='excel 8.0;hdr=no';data source=\
Sql = \ Cells.Clear
[a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close
Set Conn = Nothing End Sub
进销存汇总0407.xls
根据不重复的“产品代码”，汇总数量和金额
Sql = \产品代码,sum(进货数量),sum(进货金额) from [进货$] group by 产品代码 \如果没有group by ，就出错，显示“产品代码”不能汇总。
Sql = \产品代码,' ',sum(进货数量),进货单价,sum(进货金额) from [进货$] group by 产品代码, 进货单价\ '第2列为空，单价也成组
两表查询
Sql = \B.产品代码,' ',sum(B.进货数量),B.进货单价,sum(B.进货金额),sum(C.销售数量),C.销售单价,sum(C.销售金额) from [进货$] as B,[销售$] as C where B.产品代码=C.产品代码 group by B.产品代码,B.进货单价,C.销售单价\
三表查询
Sql = \A.产品代码,A.名称,sum(B.进货数量),B.进货单价,sum(B.进货金额),sum(C.销售数量),C.销售单价,sum(C.销售金额) from [产品资料$] as A,[进货$] as B,[销售$] as C where A.产品代码=B.产品代码 and B.产品代码=C.产品代码 group by A.产品代码,A.名称,B.进货单价,C.销售单价\
Sql = \A.产品代码,A.名称,sum(B.进货数量),B.进货单价,sum(B.进货金额),sum(C.销售数量),C.销售单价,sum(C.销售金额),sum(C.销售数量)*(C.销售单价-B.进货单价),sum(B.进货数量)-sum(C.销售数量) from [产品资料$] as A,[进货$] as B,[销售$] as C where A.产品代码=B.产品代码 and B.产品代码=C.产品代码 group by A.产品代码,A.名称,B.进货单价,C.销售单价\
9，导出工具 by:sgrshh29
‘ado导出工具.xls
‘http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=1298919&id=313282&page=1&skin=0&Star=3
Public Sub OutputTxt(strPath As String, strRange As String, LRow As Long) On Error Resume Next
Dim strSheetName As String Dim strsql As String
Dim strTxtname As String Dim strFolder As String Dim cnn As Object Dim rs As Object
strTxtname = Left(strPath, InStr(strPath, \strFolder = sNPath & LRow - 4
If Dir(strFolder & \Set cnn = CreateObject(\
With cnn
.Provider = \
.ConnectionString = \Source=\& sPath & \& strPath & \Properties=Excel 8.0;\
.CursorLocation = adUseClient .Open End With
Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF
If Right(rs.Fields(\ strSheetName = Mid(rs.Fields(\alue, 1, Len(rs.Fields(\
Exit Do End If
rs.MoveNext Loop rs.Close
Set rs = Nothing
strsql = \ & \cnn.Execute (strsql) cnn.Close
Set cnn = Nothing End Sub
10，多表汇总
‘08发票.xls Sub 分类汇总()
Range(\
Set conn = CreateObject(\
conn.Open \properties=excel 8.0;data source=\& ThisWorkbook.FullName
sq1 = \编号,日期,发票号,客户,案类,案号,律师,业务量,合作人,项目,金额,收入,应收,备注 from [1月$]\
sq2 = \编号,日期,发票号,客户,案类,案号,律师,业务量,合作人,项目,金额,收入,应收,备注 from [2月$]\
sq3 = \编号,日期,发票号,客户,案类,案号,律师,业务量,合作人,项目,金额,收入,应收,备注 from [3月$]\
sq4 = sq1 & \
sq5 = \编号,日期,发票号,客户,案类,案号,律师,业务量,合作人,项目,SUM(金额),sum(收入),sum(应收),备注 from (\编号,日期,发票号,客户,案类,案号,律师,业务量,合作人,项目,备注 order by 发票号\
[a65536].End(xlUp).Offset(1, 0).CopyFromRecordset conn.Execute(sq5) conn.Close
arr = Array(\编号\日期\发票号\客户\案类\案号\律师\业务量\合作人\项目\金额\收入\应收\备注\
[a1:n1] = arr
Set conn = Nothing Columns(\
Selection.NumberFormatLocal = \ Range(\End Sub
11，两工作表查询（ADODB_SQL、按时间段、按客户名）
‘查询.xls （自编宏之五） ‘Excel论坛
Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim Sql As String
Dim wbName As String, i&, aa$, bb$, cc$, dd$, ee$, Myr%, j% Dim Sht1 As Worksheet, Sht2 As Worksheet Sub anrqcx0130()
Set Sht1 = Worksheets(\查询表\ Set Sht2 = Worksheets(\明细表\ Sht1.Activate
Range(\ dd = [e6] ee = [f6]
wbName = ThisWorkbook.FullName Set cnn = New ADODB.Connection With cnn
.Provider = \
.ConnectionString = \ & \ .Open End With
Sql = \日期,客户名称,品名及规格,数量,单价,金额,备注 from [明细表$] where (日期 between #\
Set rs = New ADODB.Recordset
rs.Open Sql, cnn, adOpenKeyset, adLockOptimistic Sht1.Cells(12, 3).CopyFromRecordset rs [i9].Formula = \ rs.Close
Set rs = Nothing cnn.Close
Set cnn = Nothing Set ws = Nothing
End Sub
Sub ankhcx0130()
Set Sht1 = Worksheets(\查询表\ Set Sht2 = Worksheets(\明细表\ Sht1.Activate
Range(\ aa = [e8]
wbName = ThisWorkbook.FullName Set cnn = New ADODB.Connection With cnn
.Provider = \
.ConnectionString = \ & \ .Open End With
Sql = \日期,客户名称,品名及规格,数量,单价,金额,备注 from [明细表$] where 客户名称='\
Set rs = New ADODB.Recordset
rs.Open Sql, cnn, adOpenKeyset, adLockOptimistic Sht1.Cells(12, 3).CopyFromRecordset rs [i9].Formula = \