第1个回答 2016-05-21
代码的框架出来了，细节自己再完善一下
Private Sub CommandButton1_Click()
Dim M_TJ As String
Dim I, J, K As Integer
'M_TJ = ".T."
M_TJ = ""
If Cells(3, 6) <> "" Then
If M_TJ = "" Then
M_TJ = "字号 like " & "'%" & Cells(3, 6) & "%'"
Else
M_TJ = M_TJ & " AND 字号 = " & "'" & Cells(3, 6) & "'"
End If
End If
Dim CONN As New ADODB.Connection
Dim sql As String
Dim myRS As ADODB.Recordset
Set CONN = CreateObject("ADODB.Connection")
myW2 = "家族族谱查询.XLSM"
CONN.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\" & myW2
sql = " select 世代 ,字辈,谱名, 字号,排行,父亲,母亲,出生日期,辞世日期,墓园地址 from [汇总$A2:t703] WHERE " & M_TJ
Set myRS = CONN.Execute(sql)
Range("a8:q1000").ClearContents
Range("a8").CopyFromRecordset myRS
CONN.Close
Set CONN = Nothing
End Sub追问
Private Sub CommandButton1_Click()
Dim M_TJ As String
Dim I, J, K As Integer
'M_TJ = ".T."
M_TJ = ""
If Cells(3, 6) <> "" Then
If M_TJ = "" Then
M_TJ = "字号 like " & "'%" & Cells(3, 6) & "%'"
Else
M_TJ = M_TJ & " AND 字号 = " & "'" & Cells(3, 6) & "'"
End If
End If
Dim CONN As New ADODB.Connection
Dim sql As String
Dim myRS As ADODB.Recordset
Set CONN = CreateObject("ADODB.Connection")
myW2 = "家族族谱查询.XLSM"
CONN.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\" & myW2
sql = " select 世代 ,字辈,谱名, 字号,排行,父亲,母亲,出生日期,辞世日期,墓园地址 from [汇总$A2:t703] WHERE " & M_TJ
Set myRS = CONN.Execute(sql)
Range("a8:q1000").ClearContents
Range("a8").CopyFromRecordset myRS
CONN.Close
Set CONN = Nothing
End Sub追问
Hi 大神：
我是个小白，可否来个直接照搬使用的。
上面这段代码运行提示“用户定义类型未定义”
要引用追加的。
要不你付费，我帮你做好
第2个回答 2016-05-21
好像直接用函数也可以。
第3个回答 2016-05-21
我这里不能下载百度云盘，发文件给我，我帮你改一下。追问
要怎么才能把附件发给你？
追答已经有人给出答案了，我就不抢了，追问他吧。
本回答被网友采纳
相似回答