求助！列表框模糊查询速度有点慢数组办法做不出来！

lj1226189

sZqc7hdR.rar (131.63 KB, 下载次数: 118)

2005-8-11 15:25 上传

点击文件名下载附件
求助！列表框模糊查询速度有点慢数组办法做不出来！

在窗体文本框中输入1后下面列表框中显示a 列中所有包含1的单元格！但速度很慢能否用数组方法加快速度！

谢谢！

foshan

Long_III 的代码可行!但不建议使用Change事件，用Change事件在文本框中输入或删除一个字符程序均会运行一次，极大地增加了系统的负担，特别是每次要循环3万次。

UNARTHUR

long3兄的代码建议把Me.TextBox1放到一个变量里再循环

cofe2000

用sql来做也不快，提供另一种解法

Private Sub TextBox1_Change() Set x = CreateObject("ADODB.Connection") x.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName Set yy = x.Execute("select f1 from [sheet1$A:a] where f1 like '%" & TextBox1 & "%'") If Not yy.EOF Then ListBox1.List() = Split((yy.GetString(, , , ",")), ",") Set yy = Nothing: Set x = Nothing End Sub

cofe2000

有一点问题

改一下

Private Sub TextBox1_Change() Set x = CreateObject("ADODB.Connection") x.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no';Data Source=" & ThisWorkbook.FullName Set yy = x.Execute("select f1 from [sheet1$A:a] where f1 like '%" & TextBox1 & "%'") If Not yy.EOF Then ListBox1.List() = Split((yy.GetString(, , , ",")), ",") Set yy = Nothing: Set x = Nothing End Sub

lj1226189

If InStr(1, arr(i, 1), Me.TextBox1) Then 改成If InStr(Me.TextBox1,arr(i, 1))>0 Then 就不行？

另外UNARTHUR老师说的把textbox1循环怎么做！

[此贴子已经被作者于2005-8-11 16:33:46编辑过]

cofe2000

建议龙兄把arr1定义成水平数组，这样连Transpose都可以省略了

cofe2000

只是技术上的讨论而已

Application.WorksheetFunction.Transpose(arr1)多了一个函数肯定会增加时间，可能微乎其微也说不定

借你的代码改一下

Private Sub TextBox1_Change() Dim arr Dim arr1() Dim k& Application.ScreenUpdating = False Me.ListBox1.Clear If Me.TextBox1 = "" Then Exit Sub arr = Sheet1.[a1].CurrentRegion For i = 1 To UBound(arr) If InStr(1, arr(i, 1), Me.TextBox1) Then k = k + 1 ReDim Preserve arr1(k) arr1(k - 1) = arr(i, 1) End If Next Me.ListBox1.List = arr1 'Application.WorksheetFunction.Transpose(arr1) Application.ScreenUpdating = True End Sub

lj1226189

有一点不明白，我测了一下时间用

s = Me.TextBox1比不用快多了！

不知为什么！

lj1226189

谢谢！