1
Private Sub CommandButton1_Click()
Dim mydata As String, mytable As String, SQL As String Dim x As Long, Fdsarr, Arr
Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset
mydata = ThisWorkbook.Path & \ mytable = \数据表\
Set cnn = New ADODB.Connection With cnn
.Provider = \ .Open mydata End With
SQL = \ Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
Fdsarr = Array(\日期\姓名\时间\产品\数量\ ‘字段名 rs.Filter = \姓名='张三'\ ‘过滤条件
Arr = Application.Transpose(rs.GetRows(, 1, Fdsarr)) ‘记录存入数组 For x = 1 To UBound(Arr)
Cells(Arr(x, 1) + 1, 1).Resize(1, 5) = Application.Index(Arr, x, 0) Next rs.Close cnn.Close
Set rs = Nothing Set cnn = Nothing
MsgBox \数据更新完成\End Sub
38，按部门分类 先赋给数组 （GetRows）by:alzeng
‘http://club.excelhome.net/thread-643768-1-1.html ‘ADO_Getrow1106.xls Sub NewSht()
Dim Cn As Object, strSql$ Dim Arr, k%
Set Cn = CreateObject(\
Cn.Open \
Properties=Excel
8.0;Data
Source=\
Arr = Cn.Execute(\部门 From [总表$]\ For k = 0 To UBound(Arr, 2)
strSql = \总表$] Where 部门='\ With Sheets(Arr(0, k)) [A1:C1].Copy .[A1]
.[A2].CopyFromRecordset Cn.Execute(strSql) End With Next
Cn.Close: Set Cn = Nothing End Sub
39，行列转换TRANSFORM 和 PIVOT by:wsri
Sub 行列转制1()
Set rngt = Sheets(\新表\Add = rngt.Address(0, 0)
Dim cnn As New ADODB.Connection Dim rs As New ADODB.Recordset
cnn.Open \ThisWorkbook.FullName
strSQL = \别名 SELECT 规格 FROM [新表$\别名 PIVOT 规格 \
rs.Open (strSQL), cnn, adOpenKeyset, adLockReadOnly For Each Field In rs.Fields ‘aa = Field.Name
[E2].Offset(0, i) = Field.Name i = i + 1 Next
Sheets(\新表\Set rs = Nothing Set cnn = Nothing End Sub
Sub 行列转制2()
Set rngt = Sheets(\出货统计\sAddress = rngt.Address(0, 0)
Dim cnn As New ADODB.Connection Dim rs As New ADODB.Recordset
cnn.Open \ThisWorkbook.FullName
strSQL = \数量) SELECT 材料编号 FROM [出货统计$\
\材料编号 PIVOT DatePart(\日期) & '月'\
rs.Open (strSQL), cnn, adOpenKeyset, adLockReadOnly For Each Field In rs.Fields aa = Field.Name
[E1].Offset(0, i) = Field.Name i = i + 1 Next
Sheet1.Range(\Set rs = Nothing Set cnn = Nothing End Sub
Sub 行列转制3()
Set rngt = Sheets(\新表\sAddress = rngt.Address(0, 0)
Dim cnn As New ADODB.Connection Dim rs As New ADODB.Recordset
cnn.Open \ThisWorkbook.FullName
strSQL = \count(学历) SELECT 部门 FROM [新表$\& sAddress & \GROUP BY 部门 PIVOT 学历 in(大学,大专,中专)\
rs.Open (strSQL), cnn, adOpenKeyset, adLockReadOnly For Each Field In rs.Fields aa = Field.Name
[E1].Offset(0, i) = Field.Name i = i + 1 Next
Sheets(\新表\Set rs = Nothing Set cnn = Nothing End Sub
Sub 行列转制4() Sheets(\总表\
maxrow = Sheets(\总表\Set rngt = Sheets(\总表\sAddress = rngt.Address(0, 0)
Dim cnn As New ADODB.Connection Dim rs As New ADODB.Recordset
cnn.Open \ThisWorkbook.FullName
strSQL = \First(颜色) SELECT 款号,面料开发厂,编号,物料名称,使用部位说明 FROM [总表$\
\BY 款号,面料开发厂,编号,物料名称,使用部位说明 PIVOT 配色
in(-1,-2,-3) \
rs.Open (strSQL), cnn, adOpenKeyset, adLockReadOnly Sheets(\想要的结果\[a2:g1000] = \
For Each Field In rs.Fields aa = Field.Name
Sheets(\想要的结果\ i = i + 1 Next
Sheets(\想要的结果\Set rs = Nothing Set cnn = Nothing End Sub
40，多表查询
‘http://club.excelhome.net/thread-650493-1-1.html ‘面试1118.xls Sub cax()
Dim sht As Worksheet, nm$, m%, Myr& Dim sql$, conn As ADODB.Connection Application.ScreenUpdating = False
nm = \常用联系, 设置, 面试计划汇总表\Range(\Set conn = New ADODB.Connection With conn
.Provider = \
.ConnectionString = \Properties='Excel 8.0;hdr=no;';data source=\& ThisWorkbook.FullName ‘有hdr=no时要加’
.Open End With m = 4
For Each sht In Sheets
If InStr(nm, sht.Name) = 0 Then
sql = \f11>=#\
Cells(m, 1).CopyFromRecordset conn.Execute(sql) Myr = [a65536].End(xlUp).Row m = Myr + 1 End If Next
conn.Close
Set conn = Nothing
Application.ScreenUpdating = True End Sub
40_1，imex用法
Set Cn = CreateObject(\
Cn.Open \Source=\
Arr = Cn.Execute(\总表$] Where f2='\
IMEX ( IMport EXport mode )设置
IMEX 有三种模式，各自引起的读写行为也不同： 0 is Export mode 1 is Import mode
2 is Linked mode (full update capabilities)
我这里特别要说明的就是 IMEX 参数了，因为不同的模式代表著不同的读写行为： 当 IMEX=0 时为“输出模式”，这个模式开启的 Excel 档案只能用来做“写入”用途。 当 IMEX=1 时为“输入模式”，这个模式开启的 Excel 档案只能用来做“读取”用途。 当 IMEX=2 时为“链接模式(完全更新能力”，这个模式开启的 Excel 档案可同时支援“读取”与“写入”用途。
41，对Access多字段汇总
‘http://club.excelhome.net/viewthread.php?tid=650598&pid=4415665&page=1&extra=page=1
Sub yy()
Dim mydata$, mytable$, SQL$ Dim x&, y&, cnn, Arr Dim d, k, t
Set d = CreateObject(\ mydata = ThisWorkbook.Path & \数据库.mdb\ mytable = \数据\
Set cnn = CreateObject(\ With cnn
.Provider = \ .Open mydata End With
SQL = \ Arr = cnn.Execute(SQL).GetRows