EXCEL模糊查询 问题 ？

wrynata

问题 表.rar (6.71 KB, 下载次数: 16)

2010-7-13 03:09 上传

点击文件名下载附件

alzeng

1. 
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     If Target.Address <> "$E$5" Then Exit Sub
   
4.     Dim Cn As Object
   
5. 
   
6.     Set Cn = CreateObject("Adodb.Connection")
   
7.     Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
8.     [E7:E65536].ClearContents
   
9.     [E7].CopyFromRecordset Cn.Execute("Select * From [Sheet1$B:B] Where 单位名称 Like '%" & Target & "%'")
   
10.     Cn.Close: Set Cn = Nothing
    
11. End Sub
    

复制代码

dsmch

问题 表.rar (9.86 KB, 下载次数: 66)

2010-7-13 09:05 上传

点击文件名下载附件

wrynata

谢哦，经过测试效果很好.

Dim arr, r
Range("e7:e65536").ClearContents
arr = Range("b2:b" & Range("b65536").End(xlUp).Row)
For i = 1 To UBound(arr)
If arr(i, 1) Like "*" & Range("e5") & "*" Then s = s + 1: Cells(s + 6, 5) = arr(i, 1)
Next i

[ 本帖最后由 wrynata 于 2010-7-13 10:13 编辑 ]

wrynata

感谢你的回复，代码各有千秋，不错，学习了。

wrynata

Dim d, rw As Range, i As Long
If Union(Target, [G13]).Address = [G13].Address Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each rw In [C2:C26].Rows
        If InStr(rw.Cells(1), [G13]) > 0 Then
       d(rw.Cells(1)) = rw.Cells(2)
      i = i + 1
        End If
    Next rw
   [G16].Resize(i, 1) = Application.WorksheetFunction.Transpose(d.keys)
End If

sp008

好好学习，留下记号