VBA查询问题

[hdlzl]

有这样几张表,如下:
序号 编号 名称 规格 使用部门 购置日期 最新校验日期 校验人 分类 试验周期
1 #1 安全带 A05 电气班 2002\3 2007\6 张三 半年一次



电气类: 绝缘棒、绝缘手套、绝缘靴、验电笔、接地线、铝合金梯
机械类: 安全带、脚踏板、脚踏板、滑轮、吊绳（棉绳)
工器具类: 钻床、砂轮机、滑轮、吊绳（棉绳）、接地电阻测量仪、绝缘摇表、交流电焊机

要求做一张查询表：
输入电气类、机械类、工器具类（如绝缘棒、安全带、砂轮机名称）、试验周期后，按试验到期与否，已到期的器具，在页面显示所有到期的器具名称。

[scz123]

看上去excel中可以直接在原表中增加一列（是否到期），然后使用高级筛选可以解决，录制一个高级筛选的宏，作个查询按钮就可以了

[hdlzl]

to scz123(小章 http://blog.csdn.net/scz123/) :
您的思路可能可以帮我解决问题,因为以前很少接触宏,能否帮忙做?谢谢您了

[hdlzl]

to wwwwb():
运行环境如果是access的话,我想要做成ASP语言查询的,而不是VBA查询:),您能帮我吗?谢谢您提供的链接,一会儿我上传看看

[scz123]

工具／宏／录制……
然后作个高级筛选
然后停止录制，
工具／宏／VB编辑..
就可以看到代码了

添加一个按钮指定到这个宏就可以了

[scz123]

已上传到wwwwb所提供的空间：
常用安全工器具清单1.rar 21.69 KB 2007-7-20 10:35:56 scz123 高级筛选与宏应用

使用前，请将EXCEL的宏安全性设置为中：工具／宏／安全性：中
打开excel文件选择启动宏

打开后在查询条件中修改一下，然后查询就可以了

因为楼主提供的日期格式不规范，所以作了一些修改，利用替换，将顿号和点替换为日期格式用的横杆

[scz123]

哦，干好把条件查反了，修改公式：=G4+DATE(0,6,0)-NOW()<0 而不是大于0

已修正：

文件名 常用安全工器具清单1.rar （单击文件名可直接下载）
地址 http://access911.net/csdn/FileDescription.asp?mdb=2007-7-20&id=32
通过上述地址可以直接下载本文件，请复制上述 URL 链接地址
日期 2007-7-20 10:42:45
文件大小 21.62 KB
作者 scz123
描述 高级查询于宏应用（修正）

[hdlzl]

to scz123(小章 http://blog.csdn.net/scz123/) :
我下过来看看,谢谢您了,小章.同时也谢谢wwwwb所提供的空间.

[hdlzl]

to scz123(小章 http://blog.csdn.net/scz123/) :
看后觉得如果能补上模糊查询,就更好了.我再上传个模板(在excelhome下的模板),您能否按该模板的查询功能,帮我修改一下他的代码?谢谢您了

[scz123]

这个已经支持模糊查询，查询条件中，可以使用：
1、绝缘 ：可以查出"绝缘"开头的数据
2、?缘：可以查出第二个子是"缘"的数据
3、＊梯：可以查"某某梯"
4、＊安＊：可以查包含"安"的数据

[hdlzl]

to 小章:
您做的查询,我测试了一下,还有部分功能没法实现
我想做成http://www.access911.net/csdn/filedescription.asp?mdb=2007-7-23&id=33&mode=3
这样的查询效果,不知您能否帮我实现?谢谢

[scz123]

那个用ADO来查的，实现代码太多了，如果有时间的话，当然可以改代码……
楼主不妨自己看看代码：工具／宏／VB编辑..
然后修改一下

[蓝帆·雨轩]

在Excel里面同样可以执行SQL语句的，很简单的。

需要的话，和我联系。我的邮箱已经通过CSDN的短信给你了。

[hdlzl]

好的,我改改他的代码,不懂的话再向您请教,有空的话,您也帮改改,可以吗?

[hdlzl]

to Yiqun_Zhao(蓝帆·雨轩 MS MVP) :
谢谢您,短信已收到.

[kanji]

问Yiqun_Zhao(蓝帆·雨轩 MS MVP)，
在Excel里面同样可以执行SQL语句的，很简单的。
----------------------------------------------
是把EXCEL作为ODBC数据源还是别的方法？

[jacktown]

Private Sub CommandButton1_Click()
Dim CNN As New ADODB.Connection
Dim RST As New ADODB.Recordset
Dim strsql$
Dim i&, t&
Application.ScreenUpdating = False
t = WorksheetFunction.Max(Sheets("数据").Range("a:a")) + 3
CNN.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
If ComboBox2.Text <> "" Then
AA = " and 部门班组 like '%" & ComboBox2.Text & "%'"
End If
If ComboBox3.Text <> "" Then
HH = " AND 名称 like '%" & ComboBox3.Text & "%'"
End If
If ComboBox4.Text <> "" Then
BB = " AND 型号规格 like '%" & ComboBox4.Text & "%'"
End If
If ComboBox5.Text <> "" Then
CC = " AND 购置日期 like '%" & ComboBox5.Text & "%'"
End If
If ComboBox6.Text <> "" Then
DD = " AND 最新校验日期 like '%" & ComboBox6.Text & "%'"
End If
If ComboBox7.Text <> "" Then
EE = " AND 是否过期='" & ComboBox7.Text & "'"
End If
If ComboBox8.Text <> "" Then
FF = " AND 试验周期 like '%" & ComboBox8.Text & "%'"
End If
If Len(AA & BB & HH & CC & DD & EE & FF) > 4 Then
JJ = Strings.Right(AA & BB & HH & CC & DD & EE & FF, Strings.Len(AA & BB & HH & CC & DD & EE & FF) - 4)
End If
If Len(JJ) > 1 Then
strsql = "select * FROM [数据$a3:k" & t & "] where" & JJ
Else
strsql = "select * FROM [数据$a3:k" & t & "] "
End If
RST.CursorLocation = 3
RST.Open strsql, CNN, 3, 3
Sheets("查询").Range("a2").CurrentRegion.ClearContents
Sheets("查询").[a2].CopyFromRecordset RST
RST.Close
Set RST = Nothing: Set CNN = Nothing
For j = 1 To Sheets("数据").UsedRange.Columns.Count
Sheets("查询").Cells(1, j).Value = Sheets("数据").Cells(3, j).Value
Next
Application.ScreenUpdating = True
End Sub

[jacktown]

Private Sub UserForm_Initialize()

UserForm1.Caption = "数据查询___JackTown"
ComboBox7.AddItem "是"
ComboBox7.AddItem "否"
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
ComboBox5.Clear
ComboBox6.Clear
ComboBox8.Clear
If Len(Sheets("数据").Range("g4")) < 1 Or Len(Sheets("数据").Range("j4")) < 1 Then
Sheets("数据").Range("k") = "是"
Else
If DateDiff("m", Sheets("数据").Range("g4"), Now) >= Left(Sheets("数据").Range("j4"), Len(Sheets("数据").Range("j4")) - 2) Then
Sheets("数据").Range("k4") = "是"
Else
Sheets("数据").Range("k4") = "否"
End If
End If
For i = 5 To WorksheetFunction.Max(Sheets("数据").Range("a:a")) + 3
If Len(Sheets("数据").Range("g" & i)) < 1 Or Len(Sheets("数据").Range("j" & i)) < 1 Then
Sheets("数据").Range("k" & i) = "是"
Else
If DateDiff("m", Sheets("数据").Range("g" & i), Now) >= Left(Sheets("数据").Range("j" & i), Len(Sheets("数据").Range("j" & i)) - 2) Then
Sheets("数据").Range("k" & i) = "是"
Else
Sheets("数据").Range("k" & i) = "否"
End If
End If
For u = 1 To ComboBox2.ListCount
If ComboBox2.List(u - 1) = Sheets("数据").Range("e" & i) Then GoTo g_next1
Next
ComboBox2.AddItem Sheets("数据").Range("e" & i)
g_next1:
For u = 1 To ComboBox3.ListCount
If ComboBox3.List(u - 1) = Sheets("数据").Range("c" & i) Then GoTo g_next2
Next
ComboBox3.AddItem Sheets("数据").Range("c" & i)
g_next2:
For u = 1 To ComboBox4.ListCount
If ComboBox4.List(u - 1) = Sheets("数据").Range("d" & i) Then GoTo g_next3
Next
ComboBox4.AddItem Sheets("数据").Range("d" & i)
g_next3:
For u = 1 To ComboBox5.ListCount
If ComboBox5.List(u - 1) = Sheets("数据").Range("f" & i) Then GoTo g_next4
Next
ComboBox5.AddItem Sheets("数据").Range("f" & i)
g_next4:
For u = 1 To ComboBox6.ListCount
If ComboBox6.List(u - 1) = Sheets("数据").Range("g" & i) Then GoTo g_next5
Next
ComboBox6.AddItem Sheets("数据").Range("g" & i)
g_next5:
For u = 1 To ComboBox8.ListCount
If ComboBox8.List(u - 1) = Sheets("数据").Range("j" & i) Then GoTo g_next6
Next
ComboBox8.AddItem Sheets("数据").Range("j" & i)
g_next6:
Next
End Sub

[hdlzl]

谢谢jacktown(百谷之王),我试试...

[hdlzl]

可以实现模糊查询了,谢谢jacktown(百谷之王)的帮助

[szwfzx]

看看