Excel VBA_ADO+SQL实例集锦(2)

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 = \

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库Excel VBA_ADO+SQL实例集锦(2)在线全文阅读。