刚刚过去的女神节和女王节，各位女王读者是否红包收到手软，买东西买到手软？在享受购买的同时，也不要忘记投资自己，不断学习提高哦。
今天为大家带来的是Excel智能提示，那智能提示有啥用呢？可以避免输入错误，实现快速数据录入。最终的效果如下动态图演示：
看了上面的效果展示，可以看到【录入表】中的姓名列点击的时候可以出现下拉框选择，可以实现快速鼠标点选或直接Enter回车确定录入。如果觉得下拉框内容太多，可以输入【信息表】中的拼音首字母或姓名的某个字。那信息表长什么样呢？如下图所示：
正如上图中青色方块中的说明，拼音列中的拼音是使用HzToPy函数根据姓名生成的。其中B2单元格的公式为：=UPPER(HzToPy(A2,'',0,1,1))，这里用到了自定义函数HzToPy。该类模块来源于互联网，详细的使用方法请参考【HzToPy】工作表。
上面介绍的智能录入，我在好几个Excel财务软件中看到类似的实现，对于会计凭证等的录入是很方便的。智能提示的代码主要集中在【录入表】和模块【智能提示】中。
代码很长，我会在文章的最后贴上核心代码。其实代码的核心就是如何实现Textbox和Listbox的隐藏和内容。Textbox和Listbox的内容又是通过先前为大家介绍的Excel Sql实现，可以移步【VBA技巧】- 从Excel文件或Access数据库中获取指定列数据进行学习。主要用到的语句类似arr = SqlToArr('select 姓名 from [信息表$] where 姓名 like '%' & s & '%'')，其实也就是select配合like实现模糊查询。
上面的代码稍作了修改，如果各位小伙伴需要用到自己的实际工作中，只需要修改select查询部分即可，是不是很Easy呢？
可能有小伙伴就要问了，那代码是如何决定智能提示的区域的呢？这个问题很好，其实代码有一个全局常量RangeAddress就是智能提示的作用范围，可以根据需要进行修改，如下图红色框中所示。
核心代码：
Dim txt$ '检测文本框变化
Const RangeAddress = 'B5:B30' '作用范围,自己修改
'一般来说只需要整理好成品基础资料列表,然后修改RangeAddress区域范围即可
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '选择改变时改变菜单位置
Select Case userinput
Case False '列表输入状态
Call 适配(Target, RangeAddress) '第二参数为使用自动提示的单元格区域范围
Case Else
'普通输入状态 可复制粘贴,也可自己添加其他输入状态
End Select
End Sub
'根据列表得到匹配项目,该过程可自己修改为其他规则
Private Sub 智能匹配()
Dim s, selectFlag
s = UCase(TextBox1.Text) '输入的姓名或拼音
ListBox1.Clear: selectFlag = True
If s = '' Or s = ' ' Then
arr = SqlToArr('select 姓名 from [信息表$] where 姓名<>'''): selectFlag = False
Else
'先查拼音是否存在 再查姓名,都不存在则返回全部
arr = SqlToArr('select 姓名 from [信息表$] where 拼音 like '%' & s & '%'')
'--下面一句的全列表查询加不为空的条件
If TypeName(arr) = 'Empty' Then '拼音查不到查姓名
arr = SqlToArr('select 姓名 from [信息表$] where 姓名 like '%' & s & '%'')
End If
End If
If TypeName(arr) = 'Empty' Then Exit Sub
ListBox1.List = arr
If selectFlag Then ListBox1.ListIndex = 0
'If ListBox1.ListCount = 1 Then TextBox1.Text = ListBox1.List(0, 0)
End Sub
Private Sub 输入()
If ListBox1.ListIndex = -1 Then '当前输入项无匹配项直接输入
ActiveCell = TextBox1.Text
Else '输入当前匹配项
ActiveCell = ListBox1.Value
End If
ActiveCell.Offset(1, 0).Select '完成输入后跳转到下一个单元格
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
txt = TextBox1 '按键之前输入框文字
End Sub
Private Sub TextBox1_Change() '根据已输入内容查找编码列表
Call 智能匹配
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call 输入
End Sub
'--判断按键,以完成回车输入,上下方向键选择功能,以及ctr e切换输入状态
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer
Select Case KeyCode
Case vbKeyE 'ctr e切换输入状态
If Shift = 2 Then Call 输入状态切换
Case vbKeyDown
i = ListBox1.ListIndex 1
If i < ListBox1.ListCount Then ListBox1.ListIndex = i Else ListBox1.ListIndex = 0
Case vbKeyUp
i = ListBox1.ListIndex - 1
If i > -1 Then ListBox1.ListIndex = i Else ListBox1.ListIndex = ListBox1.ListCount - 1
Case vbKeyReturn
If txt = TextBox1 Then Call 输入 '处理中文输入法回车输入英文,不处理会触发回车直接输入英文
Case Else
Call 智能匹配
End Select
'TextBox1 = ListBox1.Value
End Sub
'调整控件位置和大小以适配当前输入单元格,需要其他显示格式在此处修改
Public Sub 适配(Target As Range, rng$)
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
If Target.Count = 1 Then
If 适配范围(Target, rng) Then '输入提示目标单元格作用范围
Me.ListBox1.Clear
Me.TextBox1.Text = ActiveCell.Value '将活动单元值赋给文本框
With Me.TextBox1
.Top = Target.Top
.Left = Target.Left
.Width = Target.Width
.Height = Target.Height 2
.Font.Size = Target.Font.Size - 1
.Activate
.Visible = True
End With
With Me.ListBox1
.Top = Target.Top Target.Height
.Left = Target.Left
.Width = Target.Width
.Font.Size = Target.Font.Size
.Height = Target.Height * 10
.Visible = True
End With
Call 智能匹配
Else
Me.ListBox1.Clear
Me.TextBox1 = ''
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
End If
End If
End Sub
Private Function 适配范围(Target As Range, rng$)
'对taget和限制区域求交集,无交集则返回false
'也可以在这里设置其他类型范围限制
适配范围 = True
If Intersect(Target, Range(rng)) Is Nothing Then 适配范围 = False
End Function
好了，今天的介绍就到这里了，素材的原稿，我会放到QQ群文件中，大家如果在使用智能提示过程中遇到任何问题，欢迎留言或加入QQ群（群号：615356012）交流学习哦^_^
Steven
90后小鲜肉
技术咖 效率控
金融机构 资深技术
探索新鲜事物 体验社会万象
站在不同群体看世界
QQ群：615356012
联系客服
