1, 包含空值的记录 f13 is null
‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=46032&page=1 ‘订单生成系统.xls ‘f6-第6列,f2-第2列
Private Sub Worksheet_Activate() On Error Resume Next
Dim x As Object, yy As Object, sql As String Set x = CreateObject(\
x.Open \Properties='Excel 8.0;hdr=no;';Data Source=\
sql = \f13 is null)\ ‘不等于字符串用 ‘C3’ 包含空值用 is null Set yy = x.Execute(sql) Range(\
Range(\编号\品名\规格\产地\单位\件装\属性\计划\ ‘表头 另外赋值
[a2].CopyFromRecordset yy Set yy = Nothing Set x = Nothing End Sub
2,用ADO Connection对象查询
Option Explicit
Public conn As ADODB.Connection Sub Myquery()
Dim sConnect$, sql1$
Set conn = CreateObject(\Sheets(\
sConnect = \ \
sql1 = \物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' \ '表格名要用[$],条件部分用单引号''
ThisWorkbook.Sheets(\1).CopyFromRecordset conn.Execute(sql1) 'copy后面紧接SQL查询执行语句
With Sheets(\
.Range(\物料代码\ '建立表头 .Range(\物料描述\ .Range(\属性\ .Range(\单位\ End With
'conn.Close '可不用每次关闭数据源的连接 End Sub
3,用记录集执行单个查询
Option Explicit Sub Myquery()
Dim rd As ADODB.Recordset
Dim i%, j%, k%, sConnect$, sql1$, str$ Set rd = New ADODB.Recordset str = \外协\
Sheets(\
sConnect = \ \ 'conn.Open sConnect '打开数据源
sql1 = \物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' \ '表格名要用[$],条件部分用单引号''
rd.Open sql1, sConnect, adOpenForwardOnly, adLockReadOnly ThisWorkbook.Sheets(\ With Sheets(\
.Range(\物料代码\ '建立表头 .Range(\物料描述\ .Range(\属性\ .Range(\单位\ End With
rd.Close '关闭记录集 Set rd=Nothing '关闭 End Sub
4,引用一列,如A列
‘引用单列、单行、单个单元格.xls '引用一列,如A列 Sub onecolumn() 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
Sub dgzbhz() '2008/12/2
‘http://www.exceljy.com/viewthread.php?tid=4912&pid=82252&page=1&extra=page=1#pid82252
‘Book12021.xls
‘由于分表的第2列表头是“金额”,不用它,改为“一中”,所以要用hdr=no无标题,拷贝时把第一行表头归零,所以最后要加表头。
Dim Sql$
Set Conn = CreateObject(\ [b2:d4] = \
arr = Array(\一中\二中\三中\ For i = 0 To UBound(arr) Conn.Open \properties='excel 8.0;hdr=no';data source=\
Sql = \
Cells(1, i + 2).CopyFromRecordset Conn.Execute(Sql) Conn.Close Next i
Set Conn = Nothing [b1:d1] = arr End Sub
‘test1203.xls EH
‘有标题不用hdr=no,列名用编码文字,可往下连续取数据。 Private Function cnn() As Object
Set cnn = CreateObject(\ cnn.Open \Properties ='Excel 8.0;HDR=no';Data Source= \
End Function
Sub onecolumn()
Dim Sql$, Sht1 As Worksheet, Sht As Worksheet Dim n
Set Sht1 = Sheets(\汇总\ Sht1.Activate
‘Set Conn = CreateObject(\
‘Conn.Open \& ThisWorkbook.FullName
For Each Sht In Sheets
If Sht.Name <> \汇总\
Sql = \编码 from [\ n = [b65536].End(xlUp).Row + 1
Sht1.Cells(n, 2).CopyFromRecordset Cnn.Execute(Sql) End If Next Sht Cnn.Close
Set Cnn = Nothing End Sub
5,引用一行,如第1行
'引用一
Sub onerow() 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
6,引用一个单元格,如 k1 单元格
‘2013-3-14
‘http://club.excelhome.net/thread-992260-1-1.html Dim Sql$, Conn
Sub testit()
Dim myPath$, mvvar, i&, myName$, Myr& Sheet1.Activate
[a4:h500].ClearContents
Set Conn = CreateObject(\myPath = ThisWorkbook.Path & \myName = ThisWorkbook.Name mvvar = FileList(myPath)
If TypeName(mvvar) <> \
For i = LBound(mvvar) To UBound(mvvar) If mvvar(i) <> myName Then
Conn.Open \Properties='Excel 12.0;hdr=no';data source=\
Sql = \
Myr = [a65536].End(xlUp).Row + 1 If Myr < 4 Then Myr = 4
Cells(Myr, 3).CopyFromRecordset Conn.Execute(Sql) Cells(Myr, 1) = Myr - 3
Cells(Myr, 2) = Left(mvvar(i), Len(mvvar(i)) - 4) Sql = \
Cells(Myr, 4).CopyFromRecordset Conn.Execute(Sql) Sql = \
Cells(Myr, 5).CopyFromRecordset Conn.Execute(Sql) Sql = \
Cells(Myr, 6).CopyFromRecordset Conn.Execute(Sql) Conn.Close End If Next Else
MsgBox \没有找到文件。\End If
Myr = Myr + 1
Cells(Myr, 2) = \合计\
Cells(Myr, 3).Formula = \
Cells(Myr, 3).AutoFill Cells(Myr, 3).Resize(1, 5) End Sub
Function FileList(fldr, Optional fltr As String = \ Dim sTemp As String, sHldr As String
If Right$(fldr, 1) <> \ sTemp = Dir(fldr & fltr) If sTemp = \ FileList = False Exit Function End If Do
sHldr = Dir
If sHldr = \ sTemp = sTemp & \ Loop
FileList = Split(sTemp, \End Function
'引用一个单元格,如 k1 单元格 Sub onecell() Dim Sql$
Set Conn = CreateObject(\