|
集成服务中心经常要做项目预算，其中涉及到很多的存货信息，并且采购部据此进行采购，销售管理组据此录入销售订单，因此没有统一的存货编码和存货名称是肯定不行的。为此，我在网上查阅了一些资料，设计了一个模糊参照存货信息，弹出列表框进行选择的小程序，以提高各部门工作效率。此程序有两个工作表，一个是存货档案，可以连到用友账套数据库实时更新，一个是参照选择的工作表，只需输入查询关键字，例如：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 最终效果如下：  |
|
|
