Cn.Open \Properties=Excel 8.0;Data Source=\
Sqlstr = \编号,经办人,单位,发生日期,sum(内容A),sum(内容B),sum(内容C),sum(内容D) From [总表$a3:i1000] where 经办人='\
Sql = \ 编号=\
Sql1 = \ (发生日期 between #\编号,经办人,单位,发生日期\
If jbr = \经办人不能为空白！\ If bh = \
If ks <> \ Sqlstr = Sqlstr & Sql1 Else
Sqlstr = Sqlstr & \编号,经办人,单位,发生日期\ End If
ElseIf ks <> \ Sqlstr = Sqlstr & Sql & Sql1 Else
Sqlstr = Sqlstr & Sql & \编号,经办人,单位,发生日期\ End If
With Sheet2
.[a6:h5536].Clear
.[a6].CopyFromRecordset Cn.Execute(Sqlstr) Myr = .[a65536].End(3).Row .Cells(Myr + 1, 3) = \合计\
.Cells(Myr + 1, 5).Formula = \
.Cells(Myr + 1, 5).AutoFill .Cells(Myr + 1, 5).Resize(1, 4) With .Range(\ .Font.Name = \微软雅黑\ .Font.Size = 10
.HorizontalAlignment = xlCenter .Borders.LineStyle = 1 End With
With .Range(\
.NumberFormat = \月\日\ End With
Cn.Close: Set Cn = Nothing
End With
Application.ScreenUpdating = True End Sub
33，模糊查询（Like）by:alzeng
‘http://club.excelhome.net/thread-595081-1-1.html
Private Sub CommandButton1_Click() Dim Cn As Object, Sqlstr$
Set Cn = CreateObject(\
Cn.Open \Properties=Excel 8.0;Data Source=\
Sqlstr = \数据源$] Where 客户名称&合同名称 Like '%\ ‘%相当于*[b2]*，注意下划线处的用法
[4:65536].Delete
[A4].CopyFromRecordset Cn.Execute(Sqlstr) Cn.Close: Set Cn = Nothing
[A65536].End(3)(2) = \合计\
[D65536].End(3)(2) = \End Sub
34，2级动态数据有效性（ADO RST+组合框）
http://club.excelhome.net/viewthread.php?tid=630577&pid=4268345&page=1&extra=page=1 Private Sub ComboBox1_Change() '先引用MS ADO 2.7
Dim BtArr() As Byte, zdm$
Dim cnn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim myPath As String Dim myTable As String Me.ComboBox2.Clear
zdm = Me.ComboBox1.Text
myPath = ThisWorkbook.Path & \
cnn.Open \ If Me.ComboBox1 <> \供应商\ myTable = \内容\ Else
myTable = \供应商\ End If
rst.Open \ ‘字段名、表格名用变量 rst.MoveFirst Do
Me.ComboBox2.AddItem rst(zdm) rst.MoveNext
Loop While Not rst.EOF
Me.ComboBox2.SetFocus
End Sub
Private Sub UserForm_Initialize() Dim i As Byte For i = 1 To 5
Me.ComboBox1.AddItem Array(\供应商\单号\描述\单位\货币\Next End Sub
35，TRANSFORM 和 PIVOT by:extyg
‘http://club.excelhome.net/viewthread.php?tid=632810&pid=4286508&page=1&extra=page=1
‘技巧222 有用的交叉查询.xls Sub ADOTransForm1() Dim i As Integer
Dim strSQL As String
Dim cnn As New ADODB.Connection cnn.Open \Properties='Excel 8.0;HDR=no;';Data Source=\
strSQL = \数据表$A3:c] GROUP BY f1 PIVOT f2 in (园地,木薯,其它旱地)\
With Sheet3
.Range(\
.Range(\ .UsedRange = .UsedRange.Value End With cnn.Close
Set cnn = Nothing End Sub
‘dlz.xls Sub aa()
Dim str As String
str = Sheet3.Range(\
Set x = CreateObject(\
x.Open \
SQL = \sum(贷方发生额) SELECT [年度],[月份],[凭证号码],[摘要],[借方发生额],[贷方发生额] FROM [记录] WHERE [一级科目] like'\年度],[月份],[凭证号码],[摘要],[借方发生额],[贷方发生额] pivot 二级科目\
Set y = x.Execute(SQL) For Each zz In y.Fields i = i + 1
Sheet3.Cells(2, i) = zz.Name Next
Sheet3.[a3].CopyFromRecordset y End Sub
‘http://www.excelpx.com/dispbbs.asp?boardid=5&id=147948&star=2#2078289 ‘销售日报表1109.xls Sub xs()
Dim Sql As String, x, y, zz, i, Myr&
Set x = CreateObject(\
x.Open \Properties=Excel 8.0;Data Source=\& ThisWorkbook.FullName
Sql = \销售金额) SELECT 客户 FROM [销售$] group by 客户 pivot 日期\Set y = x.Execute(Sql) i = 6
Sheet1.Activate
Cells(4, 7).Resize(1000, 100).ClearContents For Each zz In y.Fields i = i + 1
Sheet1.Cells(4, i) = zz.Name Next
[g5].CopyFromRecordset y
Myr = [g65536].End(xlUp).Row Range(\Range(\[g3] = \本期销售明细\End Sub
Sub TranPivot() 'by:mineshine
'http://club.excelhome.net/thread-774876-1-1.html
Dim i As Integer, conn As Object, rs As Object, Field As Object Sheet1.Range(\ '清除 Set conn = CreateObject(\ Set rs = CreateObject(\
conn.Open \Properties=Excel 8.0;Data Source=\
Sql = \填数) select 依据 from [Sheet1$a1:c13] group by 依据 pivot 条件 in(0,1,2,3,4,5)\
rs.Open (Sql), conn, 1, 1 For Each Field In rs.fields
If i > 0 Then [O2].Offset(0, i) = Field.Name '条件 i = i + 1 Next
Sheet1.Range(\ '行列转置结果 conn.Close
Set rs = Nothing Set conn = Nothing End Sub
36，多条件多表模糊查询（Like）by:zhaogang1960
‘http://club.excelhome.net/viewthread.php?tid=642360&pid=4363053&page=2&extra= ‘需要先引用Microsoft ActiveX Data Objects 2.x Library Private Sub CommandButton1_Click() Dim cnn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim strSql$, a, arr, s$, i&
Application.ScreenUpdating = False
[A6].CurrentRegion.Offset(1).ClearContents ‘A6为首的当前区域的下面一行以下的区域清空
If [O4] = \
strSql = \ arr = [A2:M2] For i = 1 To 13
If arr(1, i) <> \ Next
If s = \
strSql = strSql & \
cnn.Open \properties='excel 8.0;hdr=no';data source=\
rst.Open strSql, cnn, adOpenStatic [A7].CopyFromRecordset rst cnn.Close
Set rst = Nothing Set cnn = Nothing 100
Application.ScreenUpdating = True End Sub
37，ADO记录存入数组
‘http://club.excelhome.net/viewthread.php?tid=645766&pid=4383209&page=1&extra=page=