[原创] 0秒,快速模糊搜索

xuzong

拿下慢慢研究研究

geoLu

VBA中有Bug：

对多工作表操作时，当前查询的工作表中没有符合查找项时会把上一个工作表的查找结果带下来，造成误差

修改如下：

r = "" '这是新增语句
a = [c65536].End(xlUp).Row + 1
If UCase(ch.Name) = "SHEET1" Then GoTo 1
r = ch.Cells.Find(What:=[b2]).Address
If r = "" Then GoTo 1 '这是新增语句
fr = r

qq198310

以下是引用[I]qee用[/I]在2006-5-16 11:29:34的发言：[BR]看ldy888兄滴贴子，总是让人愉悦滴。
读ldy888兄滴代码，不吃力，但收获却是相当不小滴。
那代码写滴，是相当不错滴。俺给改改，也是相当不错滴。
可是俺上传这个东东，竟用了俺N多倍于改改的时间！

请教一下：我的数据表总共有10列，我想要的结果是：将含有搜索内容的字符所在行的10列数据全部显示出来，该如何用你的方法实现？

9971gh

是很好，不错，先收藏下来了。但有个问题请教：

1、VBA第一阶简单了宏与函数或是小程式体，

2、VBA第二阶就应该是模块/*.DLL/*.API吧，

3、VBA第三阶就应该是类了吧，

我有个朋友搞过VB，听他说了，

哎，没时间去看，如果有时间去学习，就好。顶，谢稿楼主的分享

qq198310

以下是引用[I]ldy888[/I]在2006-5-16 1:45:09的发言：[BR]

如果一行中有几个相同关键字,就会反应出相同的几行.

把代码中所有的"[b2]"都改成"[b1]",搜索内容要写在B1格

第一处Cells(a, 5) = Sheets(ch.Name).Range(r) 改为

Sheets(ch.Name).Rows(Sheets(ch.Name).Cells.Find(What:=[b2]).Row).Copy Rows(a + 1)

第二处Cells(a, 5) = Sheets(ch.Name).Range(r)改为

Sheets(ch.Name).Rows(Sheets(ch.Name).Cells.FindNext(after:=Sheets(ch.Name).Range(r)).Row). _Copy Rows(a + 1)

如不想要表名和单元地址,把两处Cells(a, 3) = ch.Name Cells(a, 4) =r 都去掉,再把上文的两处+1去掉

谢谢啊，可是太慢了，如果不是整行，而是前10列就可以了，如何修改？谢谢！

qee用

楼上的问题我看得似懂非懂,建议上传附件+说明.

qq198310

以下是引用[I]qee用[/I]在2006-5-16 20:33:37的发言：[BR]楼上的问题我看得似懂非懂,建议上传附件+说明.

我要搜索的表格是一个有数万条记录，表格格式如下： 产品名　代码……　　　　 产品1A01　　　　　 产品2A02　　　　　 产品3A03　　　　　 产品4A04　　　　　 产品5A05　　　　　 产品6A06　　　　　 产品7A07　　　　　 产品8A08　　　　　 产品9A09　　　　　 产品10A10　　　　　 产品11A11　　　　　 产品12A12　　　　　 产品13A13　　　　　 通常客户写出来的是名字，我需要通过对产品名的模糊匹配来找到该产品对应的代码输入到数据库中。这个时候我利用你写的代码是就需要再搜索结果中将代码的信息也显示出来，该如何做？我写了几个，都感觉太慢，你们的方法很好，搜索起来比较快。请指教，谢谢！

qee用

你不必上传全部的内容,能说明问题就可以,只用文字是无法准确理解你的意思的,具体的代码也没地方写啊.

qq198310

以下是引用[I]qee用[/I]在2006-5-16 22:03:21的发言：

你不必上传全部的内容,能说明问题就可以,只用文字是无法准确理解你的意思的,具体的代码也没地方写啊.

GwQaow3Z.rar (22.98 KB, 下载次数: 39)

2006-5-16 22:12 上传

点击文件名下载附件
[原创] 0秒,快速模糊搜索

谢谢！~~ 我原来的文件太大了，刚刚自己做了一个，看看能不能明白我的意思？从结果中筛选的功能可以不做，第一步我描述的模糊搜索问题能不能实现呢？谢谢了！

[此贴子已经被作者于2006-5-16 22:49:03编辑过]

qee用

如果从30楼所传表情况看,推荐使用ADO更合适.
Sub aTest()
On Error Resume Next
Dim cn As Object, Sql$, sh As Worksheet
Set cn = CreateObject("ADODB.Connection")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
Application.ScreenUpdating = False
Sheets("Result").Select
Range("A4:H" & [A65536].End(xlUp).Row + 1).ClearContents
For Each sh In Worksheets
If sh.Name <> "Result" Then
Sql = "select * from [" & sh.Name & "$] where 药名 like '%" & [b1].Text & "%'"
[A65536].End(xlUp).Offset(1, 0).CopyFromRecordset cn.Execute(Sql)
End If
Next sh
Application.ScreenUpdating = False
cn.Close
Set cn = Nothing
End Sub