EXCEL模糊参照列表框运用

集成服务中心经常要做项目预算，其中涉及到很多的存货信息，并且采购部据此进行采购，销售管理组据此录入销售订单，因此没有统一的存货编码和存货名称是肯定不行的。为此，我在网上查阅了一些资料，设计了一个模糊参照存货信息，弹出列表框进行选择的小程序，以提高各部门工作效率。此程序有两个工作表，一个是存货档案，可以连到用友账套数据库实时更新，一个是参照选择的工作表，只需输入查询关键字，例如：IBM，程序就会弹出一个列表框，显示存货编码、或存货名称、或存货规格型号中含有IBM的存货信息，不区分大小写。双击即可选定到工作表中。设计过程中曾遇到一些小问题：
1、大小写问题。后来查到UCASE函数，于是在代码中将条件与查询关键字都转成大写再查询即可。
2、在三个字段中查询。一开始用 where  存货编码+品名+规格型号 like '%关键字%'，结果有误，后改为：where  条件1 or 条件2 or 条件3即可。
3、给窗体赋予多条记录。想起做网页的时候曾用过rs.MoveNext，搬过来用上，结果搞定！
   
关键代码如下：
''参照查询工作表代码:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 6 Then
        Target.Select
        h = Selection.Row
        If Range("a" & h) = "" Then Exit Sub
           UserForm2.Show (vbModeless)
    Else
    Exit Sub
    End If
End Sub
''USERFORM窗体代码:
Private Sub UserForm_Initialize()
    a2 = UCase(Selection)
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim mySheet As String
    Dim n As Integer
    Dim SQL As String
    Dim cnnStr As String
    Dim myWbName As String
    Dim ws As Worksheet
    myWbName = ThisWorkbook.FullName
    mySheet = Worksheets("存货档案").Name
    
    h = Selection.Row
    cnnStr = "Provider=microsoft.jet.oledb.4.0;" _
        & "Extended Properties=Excel 8.0;" _
        & "Data Source=" & myWbName
    cnn.Open cnnStr
    SQL = "select [存货编码],[品名],[规格型号] from [" & mySheet & "$] where UCASE(存货编码) like '%" & UCase(Range("A" & h)) & "%' or UCASE(品名) like '%" & UCase(Range("A" & h)) & "%' or UCASE(规格型号) like '%" & UCase(Range("A" & h)) & "%' order by 存货编码"
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
    n = rs.RecordCount
        For i = 1 To n
        If rs.EOF = False Then ListBox1.AddItem (rs(0) & " " & rs(1) & " " & rs(2))
        rs.MoveNext
        Next i      
End Sub
2010-3-29 发现上述代码造成EXCEL关闭时自动弹出宏密码框，原因未知，于是考虑改进的方法，最终简化并改进为：
Private Sub UserForm_Initialize()
    a2 = UCase(Selection)
    With Worksheets("存货档案")
        ed = .[b65536].End(xlUp).Row
        For i = 2 To ed
        If InStr(UCase(.Range("a" & i)), a2) + InStr(UCase(.Range("a" & i)), a2) + InStr(UCase(.Range("c" & i)), a2) > 0 Then ListBox1.AddItem (.Range("a" & i) & " " & .Range("b" & i) & " " & .Range("c" & i))
        Next i
    End With
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    a1 = ListBox1.Value
    h = Selection.Row
    l = InStr(a1, " ")
    Selection.Value = Left(a1, l - 1)
    a1 = Mid(a1, l + 1)
    l = InStr(a1, " ")
    Range("D" & h) = Left(a1, l - 1)
    Range("E" & h) = Mid(a1, l + 1)
    Unload UserForm2
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    On Error Resume Next
    a1 = ListBox1.Value
    h = Selection.Row
    l = InStr(a1, " ")
    Selection.Value = Left(a1, l - 1)
    a1 = Mid(a1, l + 1)
    l = InStr(a1, " ")
    Range("D" & h) = Left(a1, l - 1)
    Range("E" & h) = Mid(a1, l + 1)
    Unload UserForm2
End Sub
最终效果如下：