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

ldy888 · 发表于 2006-5-19 15:06

以下是引用[I]gwyhm[/I]在2006-5-19 14:43:26的发言：[BR]
提点意见。
如果完整收缩就收索不到，是什么问题呢？是否可以更改？

我试过没问题啊.就是只有一个合条件的都能找出来.但会带出几条没用的. 修改方法看23楼.

爱歌学习 · 发表于 2006-5-19 17:15

MsC8Dah6.rar (37.2 KB, 下载次数: 70)

以下是引用[I]qq198310[/I]在2006-5-18 22:01:03的发言：[BR]
非常感谢你的共享，我试了一下，提高了不少效率，但还是有一点不尽完美的地方，就是在结果中筛选的时候我看不出来你写的语句中什么地方不大对，即使条件相同的情况下每次筛选都会减少最后一个行数据，能否修正一下？谢谢！！方便的话把你的程序注释一下好吗?我得好好跟前辈学习学习！这个东西开发好了我这里的工作效率会提高很多。如果每个查询少3秒的话，我们一个星期星期至少要查询10万次，真的很有用处。谢谢啦！！

已修正，倒数第4行： Range("A" & 4 + RST.RecordCount & ":H" & rowend+1).ClearContents 程序中所用方法这里都有介绍： http://club.excelhome.net/dispbbs.asp?boardid=2&id=160847&star=1#355541，先看看？

qq198310 · 发表于 2006-5-19 22:59

以下是引用[I]爱歌学习[/I]在2006-5-19 17:15:51的发言：

以下是引用[I]qq198310[/I]在2006-5-18 22:01:03的发言：
非常感谢你的共享，我试了一下，提高了不少效率，但还是有一点不尽完美的地方，就是在结果中筛选的时候我看不出来你写的语句中什么地方不大对，即使条件相同的情况下每次筛选都会减少最后一个行数据，能否修正一下？谢谢！！方便的话把你的程序注释一下好吗?我得好好跟前辈学习学习！这个东西开发好了我这里的工作效率会提高很多。如果每个查询少3秒的话，我们一个星期星期至少要查询10万次，真的很有用处。谢谢啦！！
已修正，倒数第4行： Range("A" & 4 + RST.RecordCount & ":H" & rowend+1).ClearContents 程序中所用方法这里都有介绍： http://club.excelhome.net/dispbbs.asp?boardid=2&id=160847&star=1#355541，先看看？

谢谢你的大力支持，我已经发新帖来专门讨论这问题了，希望您能继续参与并给与更大的支持。谢谢！帖子地址： http://club.excelhome.net/dispbbs.asp?boardID=2&ID=167575&page=1&px=0
[此贴子已经被作者于2006-5-19 23:52:38编辑过]

sesell · 发表于 2006-5-21 14:59

不喜欢楼主的编程（学过编程的朋友应该都被告诫尽量不要GoTo、变量可读性）及书写（缩进）习惯，于是修改了一下，运用数组，速席从2秒减少到0.56秒（以我的机子计算）。另外，楼主的结果第一、二个重复？

1rylJuqC.rar (16.07 KB, 下载次数: 81)

sesell · 发表于 2006-5-21 15:21

另：qee用兄用UsedRange来搜，我对比了一下，UsedRange比Cells慢了约0.2秒

qee用 · 发表于 2006-5-21 15:46

以下是引用[I]sesell[/I]在2006-5-21 15:21:32的发言：[BR]
另：qee用兄用UsedRange来搜，我对比了一下，UsedRange比Cells慢了约0.2秒

sesell兄说的对，刚看你的代码时，我甚至没看出差别。我原以为USEDRANGE范围比CELLS范围小，应当快，所以没试CELLS，没想到反而慢。谢谢了。把我原来代码USEDRANGE全替换为CELLS，和你的速度有细微差别，就是动态数组的处理。你比较看看。 Sub fndinc() Dim i&, s$, arr$() Dim sh As Worksheet, ce As Range, ce0 As Range, t0 t0 = Timer Application.ScreenUpdating = False s = [b2].Text i = 1 ReDim arr(1 To 3, 1 To 65535) For Each sh In Worksheets If UCase(sh.Name) = "SHEET1" Then GoTo nsh With sh Set ce0 = .Cells.Find(what:=s, after:=.Cells(1, 1), LookIn:=xlValues, lookat:=xlPart, searchdirection:=xlNext) If Not ce0 Is Nothing Then Set ce = ce0 Do arr(1, i) = .Name arr(2, i) = ce.Address arr(3, i) = ce.Text i = i + 1 Set ce = .Cells.FindNext(after:=ce) Loop While ce.Address <> ce0.Address End If End With nsh: Next sh ReDim Preserve arr(1 To 3, 1 To i - 1) Range("C2:E" & [E65536].End(xlUp).Row + 1).ClearContents Range("C2:E" & i) = Application.WorksheetFunction.Transpose(arr) Application.ScreenUpdating = True MsgBox Timer - t0 & "秒" End Sub

sesell · 发表于 2006-5-21 16:58

测试了一下，重定义数组对速度影响不大。反而是With，我用了With后速度有所提高（和你应该一样了）。另外就是.Name，先SheetName=.Name后再Do，快一些。

另：一个习惯，我喜欢先i=i+1，再赋值，后面就不用减1了。

sesell · 发表于 2006-5-21 17:11

Sub sese()

Dim arr$(), strB2$, fn$, intRows&, i&, t, firstAddress
Dim c As Range
t = Timer
Application.ScreenUpdating = False
On Error Resume Next
strB2 = Cells(2, 2)
intRows = 0
'ReDim arr(1 To 3, 1 To 65535)
For i = 2 To Sheets.Count
With Sheets(i)
Set c = .Cells.Find(what:=strB2)
If Not c Is Nothing Then
firstAddress = c.Address
fn = .Name
Do
intRows = intRows + 1
ReDim Preserve arr(1 To 3, 1 To intRows)
arr(1, intRows) = fn 'Sheets(i).Name
arr(2, intRows) = c.Address
arr(3, intRows) = c.Value
Set c = .Cells.FindNext(c)
Loop While c.Address <> firstAddress
End If
End With
Next
'ReDim Preserve arr(1 To 3, 1 To intRows)
Columns("C:E").ClearContents
Range("C1:E" & intRows) = Application.Transpose(arr)
Application.ScreenUpdating = True
MsgBox Timer - t & "秒"
End Sub

eedifier · 发表于 2006-5-23 01:40

根据以上各位提出了各种方法,我像这么运用,不知道能否实现,请各位看一下我的附件并帮忙看看.感谢!

ldy888 · 发表于 2006-5-23 10:42

我做的东西中,有一条功能和你想要的很相似.

不过是只提取数值,修改后存回原表,已在使用,等有空修改后传上来.

大家研究研究,记得到时捧场

		自动登录	找回密码
密码			免费注册