反对校园欺凌作文800:输入时逐步提示信息

http://club.excelhome.net/thread-395683-65-1.html

第8部分 控件与用户窗体

技巧114         输入时逐步提示信息
       用户在录入数据时，比如在工作表中输入产品名称，除了希望有所有产品名称的下拉列表供选择外，更希望能逐步给出提示信息。比如在输入一两个字符后把符合条件的数据筛选出来供选择，最好是中英文、拼音首字母、大小写能混合查询，如输入“LJ”或“六角”后所有以“六角”开头的产品名称都筛选到列表中供选择，这将大大提高录入速度和正确率。
为了达到这一目的，首先在工作簿需要有如图所示的基础数据表。

       基础数据表中A列保存不重复的产品名称，为了能用中英文、拼音首字母、大小写混合查询，要把产品名称转换成小写的拼音首字母保存在B列。
       步骤1：在VBE窗口单击菜单“插入”→“模块”，在代码窗口写入下面的代码。 普通浏览复制代码保存代码打印代码

1. #001  Public Function LChin(Str As String) As Variant
2. #002      On Error Resume Next
3. #003      Str = StrConv(Str, vbNarrow)
4. #004      If Asc(Str) > 0 Or Err.Number = 1004 Then LChin = ""
5. #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)
6. #006  End Function

#001  Public Function LChin(Str As String) As Variant<br />#002      On Error Resume Next<br />#003      Str = StrConv(Str, vbNarrow)<br />#004      If Asc(Str) > 0 Or Err.Number = 1004 Then LChin = ""<br />#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)<br />#006  End Function代码解析：
       自定义LChin函数，该函数把中文字符转换为拼音首字母。
       步骤2：在VBE窗口双击Sheet2表，在代码窗口写入下面的代码。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub Worksheet_Change(ByVal Target As Range)
2. #002      Dim i As Integer
3. #003      Dim myStr As String
4. #004      With Target
5. #005          If .Column <> 1 Or .Count > 1 Then Exit Sub
6. #006          If WorksheetFunction.CountIf(Sheet2.Range("A:A"), .Value) > 1 Then
7. #007              .Value = ""
8. #008              MsgBox "不能输入重复的产品名称!", 64
9. #009              Exit Sub
10. #010          End If
11. #011          For i = 1 To Len(.Value)
12. #012              If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
13. #013                  myStr = myStr & LChin(Mid$(.Value, i, 1))
14. #014              Else
15. #015                  myStr = myStr & LCase(Mid$(.Value, i, 1))
16. #016              End If
17. #017          Next
18. #018          .Offset(, 1).Value = myStr
19. #019      End With
20. #020   End Sub

#001  Private Sub Worksheet_Change(ByVal Target As Range)<br />#002      Dim i As Integer<br />#003      Dim myStr As String<br />#004      With Target<br />#005          If .Column <> 1 Or .Count > 1 Then Exit Sub<br />#006          If WorksheetFunction.CountIf(Sheet2.Range("A:A"), .Value) > 1 Then<br />#007              .Value = ""<br />#008              MsgBox "不能输入重复的产品名称!", 64<br />#009              Exit Sub<br />#010          End If<br />#011          For i = 1 To Len(.Value)<br />#012              If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then<br />#013                  myStr = myStr & LChin(Mid$(.Value, i, 1))<br />#014              Else<br />#015                  myStr = myStr & LCase(Mid$(.Value, i, 1))<br />#016              End If<br />#017          Next<br />#018          .Offset(, 1).Value = myStr<br />#019      End With<br />#020   End Sub代码解析：
       工作表的Change事件，当A列输入不重复的产品名称后，转换成小写的字母保存在B列的单元格中，便于以后的查询。
       第11行代码，设置事件触发的条件，只有在A列输入产品名称后才触发Change事件。
        第12行到第16行代码，使用工作表CountIf函数检查输入的产品名称是否重复。
       第17行到第23行代码，字符的转换过程。首先检查是否是中文字符，如果是使用自定义函数LChin转换成小写拼音首字母。如果是大写的英文字母使用LCase函数转换成小写字母。
       第24行代码，将转换后的字符保存到B列。
       步骤3：基础数据表完成后，在工作表“录入表”中添加一个文本框控件和一个列表框控件。在VBE窗口中双击Sheet1表，写入下面的代码。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
2. #002      Dim i As Integer
3. #003      If Target.Count = 1 Then
4. #004          If Target.Column = 1 And Target.Row > 1 Then
5. #005              With Me.TextBox1
6. #006                  .Visible = True
7. #007                  .Top = Target.Top
8. #008                  .Left = Target.Left
9. #009                  .Width = Target.Width
10. #010                  .Height = Target.Height
11. #011                  .Activate
12. #012              End With
13. #013              With Me.ListBox1
14. #014                  .Visible = True
15. #015                  .Top = Target.Top
16. #016                  .Left = Target.Left + Target.Width
17. #017                  .Width = Target.Width
18. #018                  .Height = Target.Height * 5
19. #019                  For i = 2 To Sheet2.Range("A65536").End(xlUp).Row
20. #020                      .AddItem Sheet2.Cells(i, 1).Value
21. #021                  Next
22. #022              End With
23. #023          Else
24. #024              Me.ListBox1.Clear
25. #025              Me.TextBox1 = ""
26. #026              Me.ListBox1.Visible = False
27. #027              Me.TextBox1.Visible = False
28. #028          End If
29. #029      End If
30. #030  End Sub

#001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)<br />#002      Dim i As Integer<br />#003      If Target.Count = 1 Then<br />#004          If Target.Column = 1 And Target.Row > 1 Then<br />#005              With Me.TextBox1<br />#006                  .Visible = True<br />#007                  .Top = Target.Top<br />#008                  .Left = Target.Left<br />#009                  .Width = Target.Width<br />#010                  .Height = Target.Height<br />#011                  .Activate<br />#012              End With<br />#013              With Me.ListBox1<br />#014                  .Visible = True<br />#015                  .Top = Target.Top<br />#016                  .Left = Target.Left + Target.Width<br />#017                  .Width = Target.Width<br />#018                  .Height = Target.Height * 5<br />#019                  For i = 2 To Sheet2.Range("A65536").End(xlUp).Row<br />#020                      .AddItem Sheet2.Cells(i, 1).Value<br />#021                  Next<br />#022              End With<br />#023          Else<br />#024              Me.ListBox1.Clear<br />#025              Me.TextBox1 = ""<br />#026              Me.ListBox1.Visible = False<br />#027              Me.TextBox1.Visible = False<br />#028          End If<br />#029      End If<br />#030  End Sub代码解析：
       工作表的SelectionChange事件，当用户选定工作表A列第2行以下的单个单元格时，设置文本框和列表框的Visible为True，使它们成为可见的，并设置其外观，同时给列表框加载列表项。当用户选定其他列的单元格时隐藏文本框和列表框控件。
       步骤4：在设计模式下双击文本框，在代码窗口写入下面的代码。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
2. #002      Dim i As Integer
3. #003      Dim Language As Boolean
4. #004      Dim myStr As String
5. #005      Me.ListBox1.Clear
6. #006      With Me.TextBox1
7. #007          For i = 1 To Len(.Value)
8. #008              If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
9. #009                  Language = True
10. #010                  myStr = myStr & Mid$(.Value, i, 1)
11. #011              Else
12. #012                  myStr = myStr & LCase(Mid$(.Value, i, 1))
13. #013              End If
14. #014          Next
15. #015      End With
16. #016      With Sheet2
17. #017          For i = 2 To .Range("A65536").End(xlUp).Row
18. #018              If Language = True Then
19. #019                  If Left(.Cells(i, 1).Value, Len(myStr)) = myStr Then
20. #020                      Me.ListBox1.AddItem .Cells(i, 1).Value
21. #021                  End If
22. #022              Else
23. #023                  If Left(.Cells(i, 2).Value, Len(myStr)) = myStr Then
24. #024                      Me.ListBox1.AddItem .Cells(i, 1).Value
25. #025                  End If
26. #026              End If
27. #027          Next
28. #028      End With
29. #029  End Sub

#001  Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br />#002      Dim i As Integer<br />#003      Dim Language As Boolean<br />#004      Dim myStr As String<br />#005      Me.ListBox1.Clear<br />#006      With Me.TextBox1<br />#007          For i = 1 To Len(.Value)<br />#008              If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then<br />#009                  Language = True<br />#010                  myStr = myStr & Mid$(.Value, i, 1)<br />#011              Else<br />#012                  myStr = myStr & LCase(Mid$(.Value, i, 1))<br />#013              End If<br />#014          Next<br />#015      End With<br />#016      With Sheet2<br />#017          For i = 2 To .Range("A65536").End(xlUp).Row<br />#018              If Language = True Then<br />#019                  If Left(.Cells(i, 1).Value, Len(myStr)) = myStr Then<br />#020                      Me.ListBox1.AddItem .Cells(i, 1).Value<br />#021                  End If<br />#022              Else<br />#023                  If Left(.Cells(i, 2).Value, Len(myStr)) = myStr Then<br />#024                      Me.ListBox1.AddItem .Cells(i, 1).Value<br />#025                  End If<br />#026              End If<br />#027          Next<br />#028      End With<br />#029  End Sub代码解析：
       文本框的KeyUp事件，在文本框输入查询条件时筛选符合条件的数据加载到列表框。
       第3行代码，声明变量Language为Boolean数据类型，在下面的代码中使用Language的值判断输入的是否为中文。
       第5行代码，使用Clear方法删除列表框所有的列表项，语法如下：
object.Clear
       参数object是必需的，一个有效的对象。
       注意，如果列表框绑定了数据，Clear方法将会失败。
       第6行到第15行代码，判断文本框输入的是否为中文字符。如果是中文字符，将变量Language赋值为True，并把文本框中的字符赋给变量myStr。如果是英文字符则转换成小写字母后赋变量myStr。
       第16行到第29行代码，如果变量Language的值为True，在基础数据表的A列中使用Left函数查找与文本框字符相符的单元格并加载到列表框，否则就在B列查找。
       步骤5：在设计模式下双击文本框，在代码窗口写入下面的代码。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
2. #002      If KeyCode = vbKeyReturn Then
3. #003          Sheet1.ListBox1.Activate
4. #004      End If
5. #005  End Sub

#001  Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br />#002      If KeyCode = vbKeyReturn Then<br />#003          Sheet1.ListBox1.Activate<br />#004      End If<br />#005  End Sub代码解析：
       文本框的KeyDown事件，当用户在文本框中输入完成，列表框中已显示所需的内容后按回车键后选择列表框。
       步骤6：在设计模式下双击列表框，在代码窗口写入下面的代码 普通浏览复制代码保存代码打印代码

1. #001  Private Sub ListBox1_GotFocus()
2. #002      On Error Resume Next
3. #003      ListBox1.ListIndex = 0
4. #004  End Sub

#001  Private Sub ListBox1_GotFocus()<br />#002      On Error Resume Next<br />#003      ListBox1.ListIndex = 0<br />#004  End Sub代码解析：
       列表框的GotFocus事件，当用户在文本框中输入完成按回车键后，选定列表框中第1个条目，方便用户进行下一步操作。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
2. #002      If KeyCode = vbKeyReturn Then
3. #003          ActiveCell.Value = ListBox1.Value
4. #004          Me.ListBox1.Clear
5. #005          Me.TextBox1 = ""
6. #006          Me.ListBox1.Visible = False
7. #007          Me.TextBox1.Visible = False
8. #008      End If
9. #009  End Sub

#001  Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br />#002      If KeyCode = vbKeyReturn Then<br />#003          ActiveCell.Value = ListBox1.Value<br />#004          Me.ListBox1.Clear<br />#005          Me.TextBox1 = ""<br />#006          Me.ListBox1.Visible = False<br />#007          Me.TextBox1.Visible = False<br />#008      End If<br />#009  End Sub代码解析：
       列表框的KeyDown事件，当用户在列表框中按下回车后将列表框选中的条目写入到活动工作表的单元格中，同时清空文本框和列表框内容后隐藏，准备下一次录入。 普通浏览复制代码保存代码打印代码

1. #001  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
2. #002      ActiveCell.Value = ListBox1.Value
3. #003      Me.ListBox1.Clear
4. #004      Me.TextBox1 = ""
5. #005      Me.ListBox1.Visible = False
6. #006      Me.TextBox1.Visible = False
7. #007  End Sub

#001  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)<br />#002      ActiveCell.Value = ListBox1.Value<br />#003      Me.ListBox1.Clear<br />#004      Me.TextBox1 = ""<br />#005      Me.ListBox1.Visible = False<br />#006      Me.TextBox1.Visible = False<br />#007  End Sub代码解析：
       列表框的DblClick事件，当用户双击列表框的列表项时，把列表框数据赋给活动单元格，同时清空文本框和列表框内容后隐藏，准备下一次录入。
       以上设置完成后，在“录入”工作表的A列选定单元格后，显示一个文本框和一个列表框，在文本框中输入查询条件后列表框显示符合查询条件的所有内容供用户选择，如图所示。