输入时逐步提示信息.doc

输入时逐步提示信息 用户在录入数据时，比如在工作表中输入产品名称，除了希望有所有产品名称的下拉列表供选择外，更希望能逐步给出提示信息。比如在输入一两个字符后把符合条件的数据筛选出来供选择，最好是中英文、拼音首字母、大小写能混合查询，如输入“LJ”或“六角”后所有以“六角”开头的产品名称都筛选到列表中供选择，这将大大提高录入速度和正确率。 为了达到这一目的，首先在工作簿需要有如图 1141所示的基础数据表。 图 1141 基础数据表 基础数据表中A列保存不重复的产品名称，为了能用中英文、拼音首字母、大小写混合查询，要把产品名称转换成小写的拼音首字母保存在B列。 步骤1：在VBE窗口单击菜单“插入”→“模块”，在代码窗口写入下面的代码。 #001 Public Function LChin(Str As String) As Variant #002 On Error Resume Next #003 Str = StrConv(Str, vbNarrow) #004 If Asc(Str) 0 Or Err.Number = 1004 Then LChin = #005 LChin = WorksheetFunction.VLookup(Str, [{吖,a;八,b;嚓,c;咑,d;鵽,e;发,f;猤,g;铪,h;夻,j;咔,k;垃,l;嘸,m;旀,n;噢,o;妑,p;七,q;囕,r;仨,s;他,t;屲,w;夕,x;丫,y;帀,z}], 2) #006 End Function 代码解析： 自定义LChin函数，该函数把中文字符转换为拼音首字母。 步骤2：在VBE窗口双击Sheet2表，在代码窗口写入下面的代码。 #001 Private Sub Worksheet_Change(ByVal Target As Range) #002 Dim i As Integer #003 Dim myStr As String #004 With Target #005 If .Column 1 Or .Count 1 Then Exit Sub #006 If WorksheetFunction.CountIf(Sheet2.Range(A:A), .Value) 1 Then #007 .Value = #008 MsgBox 不能输入重复的产品名称!, 64 #009 Exit Sub #010 End If #011 For i = 1 To Len(.Value) #012 If Asc(Mid$(.Value, i, 1)) 255 Or Asc(Mid$(.Value, i, 1)) 0 Then #013 myStr = myStr LChin(Mid$(.Value, i, 1)) #014 Else #015 myStr = myStr LCase(Mid$(.Value, i, 1)) #016 End If #017 Next #018 .Offset(, 1).Value = myStr #019 End With #020 End Sub 代码解析： 工作表的Change事件，当A列输入不重复的产品名称后，转换成小写的字母保存在B列的单元格中，便于以后的查询。 第11行代码，设置事件触发的条件，只有在A列输入产品名称后才触发Change事件。 第12行到第16行代码，使用工作表CountIf函数检查输入的产品名称是否重复。 第17行到第23行代码，字符的转换过程。首先检查是否是中文字符，如果是使用自定义函数LChin转换成小写拼音首字母。如果是大写的英文字母使用LCase函数转换成小写字母。 第24行代码，将转换后的字符保存到B列。 步骤3：基础数据表完成后，在工作表“录入表”中添加一个文本框控件和一个列表框控件。在VBE窗口中双击Sheet1表，写入下面的代码。 #001 Private Sub Worksheet_SelectionChange(ByVal Target As Range) #002 Dim i As Integer #003 If Target.Count = 1 Then #004 If Target.Co