VBA常用技巧代码解析

ykx042907 · 发表于 2009-4-6 11:13

http://club.excelhome.net/viewth ... ;page=67#pid2683860

wolf412 · 发表于 2009-4-6 16:18

这几天一直在看，从第一楼一直看到现在，很好的

NICKCHEN · 发表于 2009-4-6 21:39

非常感谢确实很实用的

yuanzhuping · 发表于 2009-4-7 07:20

原帖由 tkgg93 于 2009-4-4 18:35 发表

点击每楼右边的楼层复制，如407楼http://club.excelhome.net/viewth ... ;page=41#pid2606490

多谢tkgg93，原来是这样的，等有空了我重新做一下楼层链接。

yuanzhuping · 发表于 2009-4-7 07:23

原帖由 chury11 于 2009-4-5 08:03 发表
43-2       错误处理方法
   使用错误处理程序判断指定名称的工作簿是否打开，如下面的代码所示。复制内容到剪贴板代码:
#013    Set Wb = Nothing
语句的作用是什么？

销毁对象，将对象变量从实际对象中分离开来，释放与被引用的对象有关联的内存资源及系统资源。

yuanzhuping · 发表于 2009-4-7 07:58

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

基础数据表中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.Column = 1 And Target.Row > 1 Then
#005 With Me.TextBox1
#006 .Visible = True
#007 .Top = Target.Top
#008 .Left = Target.Left
#009 .Width = Target.Width
#010 .Height = Target.Height
#011 .Activate
#012 End With
#013 With Me.ListBox1
#014 .Visible = True
#015 .Top = Target.Top
#016 .Left = Target.Left + Target.Width
#017 .Width = Target.Width
#018 .Height = Target.Height * 5
#019 For i = 2 To Sheet2.Range("A65536").End(xlUp).Row
#020 .AddItem Sheet2.Cells(i, 1).Value
#021 Next
#022 End With
#023 Else
#024 Me.ListBox1.Clear
#025 Me.TextBox1 = ""
#026 Me.ListBox1.Visible = False
#027 Me.TextBox1.Visible = False
#028 End If
#029 End If
#030 End Sub

复制代码

代码解析：
工作表的SelectionChange事件，当用户选定工作表A列第2行以下的单个单元格时，设置文本框和列表框的Visible为True，使它们成为可见的，并设置其外观，同时给列表框加载列表项。当用户选定其他列的单元格时隐藏文本框和列表框控件。
步骤4：在设计模式下双击文本框，在代码窗口写入下面的代码。

#001 Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
#002 Dim i As Integer
#003 Dim Language As Boolean
#004 Dim myStr As String
#005 Me.ListBox1.Clear
#006 With Me.TextBox1
#007 For i = 1 To Len(.Value)
#008 If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
#009 Language = True
#010 myStr = myStr & Mid$(.Value, i, 1)
#011 Else
#012 myStr = myStr & LCase(Mid$(.Value, i, 1))
#013 End If
#014 Next
#015 End With
#016 With Sheet2
#017 For i = 2 To .Range("A65536").End(xlUp).Row
#018 If Language = True Then
#019 If Left(.Cells(i, 1).Value, Len(myStr)) = myStr Then
#020 Me.ListBox1.AddItem .Cells(i, 1).Value
#021 End If
#022 Else
#023 If Left(.Cells(i, 2).Value, Len(myStr)) = myStr Then
#024 Me.ListBox1.AddItem .Cells(i, 1).Value
#025 End If
#026 End If
#027 Next
#028 End With
#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：在设计模式下双击文本框，在代码窗口写入下面的代码。

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

复制代码

代码解析：
文本框的KeyDown事件，当用户在文本框中输入完成，列表框中已显示所需的内容后按回车键后选择列表框。
步骤6：在设计模式下双击列表框，在代码窗口写入下面的代码

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

复制代码

代码解析：
列表框的GotFocus事件，当用户在文本框中输入完成按回车键后，选定列表框中第1个条目，方便用户进行下一步操作。

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

复制代码

代码解析：
列表框的KeyDown事件，当用户在列表框中按下回车后将列表框选中的条目写入到活动工作表的单元格中，同时清空文本框和列表框内容后隐藏，准备下一次录入。

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

复制代码

代码解析：
列表框的DblClick事件，当用户双击列表框的列表项时，把列表框数据赋给活动单元格，同时清空文本框和列表框内容后隐藏，准备下一次录入。
以上设置完成后，在“录入”工作表的A列选定单元格后，显示一个文本框和一个列表框，在文本框中输入查询条件后列表框显示符合查询条件的所有内容供用户选择，如图所示。

chury11 · 发表于 2009-4-7 08:48

原帖由 yuanzhuping 于 2009-4-7 07:23 发表

销毁对象，将对象变量从实际对象中分离开来，释放与被引用的对象有关联的内存资源及系统资源。

说白了就是让代码运行的更快，对吧？

dengxu · 发表于 2009-4-7 09:33

非常谢谢！辛苦了

笨小孩sq · 发表于 2009-4-7 15:58

太感谢版主了
作出来真有感觉啊

lyl001 · 发表于 2009-4-8 08:45

这么好的东西，一定要顶！感谢版主啦！

		自动登录	找回密码
密码			免费注册

VBA常用技巧代码解析

第8部分控件与用户窗体

评分

VBA常用技巧代码解析

第8部分 控件与用户窗体

评分

第8部分控件与用户窗体