ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 133399|回复: 221

[原创] VBA之Listbox控件基础教程

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2018-12-14 22:10 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 ivccav 于 2018-12-14 22:13 编辑



Listbox控件的历史悠久,悠久到不支持鼠标滚动键。不支持鼠标滚动键倒不是什么事,毕竟用鼠标左键也可以代替滚动操作,Listbox的主要问题是功能太少,看了它的属性和方法,感觉有用的不多,其存在的价值是兼容性好吧。Listbox的使用还是挺简单的,会使用常用的几个属性和方法就已足够,以致论坛里没有人为Listbox写一个基础的教程。不过Listbox虽简单,但初学者能把它用上手还是需要一点系统知识,所以我写了这个不算“教程”的教程,以期能给予些参考。


本帖将要讲到的内容如下:


1.基础:Listbox控件常用方法、属性和事件


1.1、常用属性
1.2、常用方法
1.3、常用事件


2.运用:Listbox控件运用举例


2.1、Listbox引用工作表数据
2.2、Listbox引用数组数据和模糊查询
2.3、Listbox如何显示“标题”
2.4、Listbox支持鼠标滚动键
2.5、Listbox多选功能和数据导出
2.6、在工作表中使用Listbox实现逐步提示输入功能


1.基础:Listbox控件常用方法、属性和事件


1.1、常用属性


(1)BackColor 属性:设定Listbox的背景色。可采用任意整数来表示某一种有效的颜色,也可采用由红、绿、蓝三种成分构成的 RGB 函数来指定颜色,每一种色素的值是 0 至 255 之间的任意整数。


(2)BorderColor 属性:指定Listbox的边框颜色。


(3)BorderStyle 属性:指定Listbox边框类型。其值可为fmBorderStyleNone :控件无可见的边框线(默认值)和fmBorderStyleSingle:控件有一单线的边框。BorderStyle 用 BorderColor 来定义其边框的颜色。


(4)ColumnCount 属性:指定Listbox的显示列数。


(5)ColumnWidths 属性:指定多列的Listbox中的各列的宽度。以磅为单位,设为 0 时则隐藏该列。ColumnWidths接受一个字符串参数,假如Listbox控件有3列,可这样设置:ListBox1.ColumnWidths = "80;90;100"。


(6)ColumnHeads 属性:设置是否显示Listbox列标题,布尔值。只有设置RowSource时,才可以显示标题。通过AddItem、List或Column赋值的Listbox无法显示标题。


(7)RowSource 属性:指定为Listbox数据的来源。RowSource 属性接受 Microsoft Excel工作表区域。可这样设置:ListBox1.RowSource = "A2:L100",当ColumnHeads为TRUE时,Listbox会自动以前一行为标题。也可以这样设置:ListBox1.RowSource = Sheet1.Range("A1:L" & Range("L" & Rows.Count).End(xlUp).Row).Address,如果要返回外部引用,Address需要加上(External:=True),且引用的工作簿需要打开。
     注意:如果指定了RowSource 属性,再使用AddItem、List或Column给Listbox赋值,将发生错误,提示“拒绝的权限”。因此,RowSource并没有多少用处,而放弃使用RowSource,同时意味着Listbox将不能显示标题,只能用第一行数据做标题,或者在窗体上用标签模拟标题。


(8)ControlTipText 属性:设置当用户将鼠标指针放在控件上但未按下时所显示的提示文本。


(9)Enabled 属性:指定一个控件能否接受焦点和响应用户产生的事件。


(10)Font 对象:定义控件所用文字的特征,包括字体,字号大小,斜体,下划线等。


(11)ForeColor 属性:指定控件的前景色,即文字的颜色。


(12)Height、Width 属性:设置或返回控件的高度和宽度,以磅为单位。数值范围是一般是 0 到 32767 之间的数值。


(13)Left、Top 属性:控件与所在容器的左边或顶边之间的距离。


(14)List 属性:Listbox最重要的属性之一。使用该属性,可以把一个数组一次性赋值给Listbox显示输出,也可以把List属性赋值给一个变量,从而获得整个Listbox列表的数据,用List(row, column)可以访问或设置Listbox列表中的每一个单元格,注意,行和列的编号从 0 开始,即列表中第一行的行号为 0,第一列的列号为 0,第二行或列的编号为 1,以此类推。
Column 属性和List 属性功能一致,用法为:Listbox1.Column( column, row ),不同之处是Column是先列后行,Column相当于List的数组转置。


(15)ListCount 属性:返回Listbox控件列表中的条目数。


(16)ListIndex 属性:Listbox最重要的属性之一。ListIndex设置或返回列表中被选中行的索引。ListIndex 的取值范围为 -1 到列表总行数减 1(即 ListCount - 1)之间的数值。当用户没有选中行时,ListIndex 返回 -1。当用户在列表框或组合框中选中一行时,系统将设置 ListIndex 值。列表中第一行的 ListIndex 值是 0,第二行的 ListIndex 值是 1,依此类推。
需要特别注意的是,如果用 MultiSelect 属性(允许多选)创建一个允许多重选择的Listbox,那么列表框的 Selected 属性(而不是 ListIndex 属性)将标识被选中的行。对于列表框中的每一行,如果该行被选中,则 Selected 为 True,否则为 False。在一个允许多重选择的列表框中,ListIndex 返回具有焦点行的索引,而不论当前该行是否被选中。


(17)ListStyle 属性:规定列表框列表的外观。可选值有两个:fmListStylePlain 和fmListStyleOption。fmListStyleOption显示选项按钮,形状跟MultiSelect属性有关。当Listbox可以多选时,选项按钮为方形□,否则为圆形○。


(18)MultiSelect 属性:设置Listbox控件是否允许多项选择。可选值为:
fmMultiSelectSingle  只可选择一个条目(默认)。
fmMultiSelectMulti 按空格键或单击鼠标以选定列表中条目或取消选定。
fmMultiSelectExtended 按Shift并单击鼠标,或按Shift的同时按一个方向键,将所选条目由前一项扩展到当前项。按Ctrl的同时单击鼠标可选定或取消选定。


(19)Selected 属性:返回或设置列表框中条目的选定状态。用法为:
Listbox1.Selected( index ) [= Boolean],其中index取值范围是 0 到列表中的条目数减 1 之间的数值。


(20)TextAlign 属性:定义控件中文本的对齐方式。其值可为:
fmTextAlignLeft 将所显示文本的第一个字符与控件显示或编辑区的左边界对齐(默认值)。
fmTextAlignCenter 在控件的显示或编辑区中,使文本中央对齐。
fmTextAlignRight 将所显示文本的最后一个字符与控件显示或编辑区的右边界对齐。


(21)TopIndex 属性:设置和返回出现在表格最顶端位置的项目。出现在顶端位置的表项的编号默认值是 0(或表中第一个项目)。如果表是空的或未被显示,返回值为 -1。


(22)Visible 属性:定义一个对象是可视的还是被隐藏的。


1.2、常用方法


(1)Clear 方法:从Listbox控件中删去所有的项。


(2)RemoveItem 方法:从列表框或组合框的列表中删去一行。语法为:Listbox1.RemoveItem index,index指定要删除的行,第一行的行号为 0,第二行的行号为 1,依此类推。如果列表框被数据绑定(也就是,当 RowSource 属性为列表框规定了数据源时),此方法不能从该列表中删去任何一行(拒绝的权限)。


(3)AddItem 方法:对于单列的列表框,在列表中添加一项。对于多列的列表框或组合框,在列表中添加一整行。用法为:Listbox1.AddItem [ item [, varIndex]]
其中Item(可选)指定要添加的项或行的内容。第一个项或行的编号为 0;第二个项或行的编号为 1,依此类推。varIndex(可选)指定新的项或行在对象中的位置。如果提供一个有效的 varIndex 的值,AddItem 方法就把项或行放在列表中的那个位置。如果忽略 varIndex,此方法就把项或行添加在列表的末尾。varIndex 的值不能大于 ListCount 属性的值。
对于多列列表框,AddItem 方法插入一个完整的行,为了给第一列后面的项赋值,可用 List 或 Column 属性来完成。如果控件绑定了数据(也就是,当 RowSource 属性为列表框规定了数据源时),AddItem 方法将会失败。


程序源码和教程电子档.zip (398.5 KB, 下载次数: 7778)


补充内容 (2019-5-11 12:31):
把所有 .AddItem , -1 改为 .AddItem , 0 ,并新增一句 .TopIndex = 0 ,详情见54楼

补充内容 (2023-1-16 21:24):
注意:使用代码更新Listbox控件的任何值时,AfterUpdate事件不会触发,而Click、Change事件会被触发。想通过点击Listbox赋值给Textbook,然后通过Textbook控件修改Listbox值这种场景,使用AfterUpdate事件

补充内容 (2023-5-24 09:33):
增加Listbox虚拟模式,可以加载数万行数据而不会有任何卡顿:

https://club.excelhome.net/forum ... 05&pid=11258749

评分

44

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:14 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助


1.3、常用事件

(1)KeyDown 和 KeyUp 事件
按下和释放某键时这两个事件依次发生。按下键时发生 KeyDown 事件,而释放键时发生 KeyUp 事件。语法:
Private Sub object_KeyDown( ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As fmShiftState)
Private Sub object_KeyUp( ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As fmShiftState)

KeyDown 和 KeyUp 事件的语法包含以下成分:
成分                         说明
object 必需。一个有效的对象名。
KeyCode 必需。整数,代表被按下或释放的键的键代码。
Shift 必需。Shift、Ctrl 和 Alt 的状态。

Shift 的设置如下:
常量                         值         说明
fmShiftMask         1         按下 Shift。
fmCtrlMask         2         按下 Ctrl。
fmAltMask                 4         按下 Alt。
对于一个运行中的窗体,如果该窗体或窗体上的某个控件具有焦点,则按下键时 KeyDown 事件发生。KeyDown 和 KeyPress 事件交替重复发生,直至用户释放此键,此刻 KeyUp 事件发生。这个具有焦点的窗体或控件接收所有的按键操作。只有在窗体上没有控件或所有可视控件全部失效时,窗体才可能具有焦点。应用宏中的 SendKeys 操作或 Visual Basic 中的 SendKeys 语句将按键操作发送到一个窗体或控件时,这些事件也会发生。
KeyDown 和 KeyUp 事件通常用于识别或区分以下各键:
扩充的字符键,比如功能键。
翻阅键,如 Home、End、PageUp、PageDown、向上、向下、向右、向左和 Tab 键。
组合键和标准键盘组合键(Shift、Ctrl 或 Alt)。
数字键区和键盘数字键。
在下列情况下,KeyDown 和 KeyUp 事件不发生:
在带有命令按钮(其 Default 属性为 True)的窗体上按 Enter。
在带有命令按钮(其 Cancel 属性为 True)的窗体上按 Esc。
在按下或发送一个 ANSI 键时,KeyDown 和 KeyPress 事件发生。KeyUp 事件发生在按下或发送该键所引起的任何控件事件之后。若一次击键导致了焦点从一个控件移到另一个控件,则对第一个控件发生 KeyDown 事件,对第二控件发生 KeyPress 和 KeyUp 事件。
注意:要解释 ANSI 字符或找出与被按下的键相对应的 ANSI 字符,用 KeyPress 事件。

(2)KeyPress 事件
当用户按下一个 ANSI 键时该事件发生。语法:
Private Sub object_KeyPress( ByVal KeyANSI As MSForms.ReturnInteger)

KeyPress 事件的语法有以下几个成分:
成分                         说明
object 必需。一个有效的对象。
KeyANSI 必需。整数值,代表标准的数字 ANSI 键代码。

当用户按下一个键,在运行的窗体上产生可键入字符(一个 ANSI 键),而该窗体或该窗体上的某个控件具有焦点时,KeyPress 事件发生。该事件可以发生在该键被释放之前,也可以发生在该键被释放之后。当用宏的 SendKey 操作或用 Visual Basic 的 SendKeys 语句,将一个 ANSI 键操作发送到窗体或控件的时候,这个事件也会发生。KeyPress 事件发生在下列任意键被按下时:
任何可打印的键盘字符。
Ctrl 与标准字母表中字符的组合。
Ctrl 与任何特殊字符的组合。
Backspace。
Esc。

在下面情况下,KeyPress 事件不发生:
按下 Tab。
按下 Enter。
按任何方向键。
引起焦点在控件之间移动的击键操作。

Backspace 是 ANSI 字符集的一部分,而 Delete 不是。在一个控件中用 Backspace 删除一个字符将引发 KeyPress 事件;而用 Delete 删除一个字符则不引发 KeyPress 事件。
按住产生 ANSI 键代码的键不放,KeyDown 和 KeyPress 事件交替重复发生。当释放此键,KeyUp 事件发生。具有焦点的窗体或控件接收所有的击键操作。只有没有控件的窗体,或者其所有可视控件都失效的窗体才可能有焦点。
KeyPress 事件的默认操作是处理被按下键所对应的事件代码。KeyANSI 指出了与所按下的键或组合键相对应的 ANSI 字符。KeyPress 事件把每个字符的大写和小写解释为互相独立的键码,因而作为两个独立的字符处理。
为了响应键盘的物理状态,或处理 KeyPress 事件无法辨认的击键操作,比如功能键、翻阅键或这些键与键盘组合键(Alt、Shift 或 Ctrl)的任意组合,可使用 KeyDown 和 KeyUp 事件过程。

(3)Click 事件
下列两种情况下,发生该事件:
用鼠标单击控件。
用户最终在几种可能的值中为控件选择一个值。

(4)DblClick 事件


当用户指向一个对象并双击鼠标时,发生 DblClick 事件。

(5)MouseDown 和 MouseUp 事件
用户单击鼠标按键时发生。用户按下鼠标按键时发生 MouseDown 事件;用户释放鼠标按键时发生 MouseUp 事件。语法
Private Sub object_MouseDown( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)
Private Sub object_MouseUp( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)

MouseDown 和 MouseUp 事件的语法包含以下成分:
成分                         说明
object 必需。一个有效的对象。
index 必需。发生特定事件的多页和 TabStrip 中的页索引或标签索引。
Button 必需。标识引起该事件的鼠标按键的整数值。
Shift 必需。规定 Shift、Ctrl 和 Alt 的状态。
X, Y 必需。窗体、框架或页的位置的横坐标与纵坐标,以磅为单位,分别从左边和顶边开始测量。

Button 的设置如下:
常量                         值 说明
fmButtonLeft         1 按下左键。
fmButtonRight         2 按下右键。
fmButtonMiddle 4 按下中键。

Shift 的设置如下:
值         说明
1         按下 Shift。
2         按下 Ctrl。
3         同时按下 Shift 和 Ctrl。
4         按下 Alt。
5         同时按下 Alt 和 Shift。
6         同时按下 Alt 和 Ctrl。
7         同时按下 Alt 、Shift 和 Ctrl。

用于标识键盘组合键的常量:
常量                 值         说明
fmShiftMask 1         检测 Shift 的标记。
fmCtrlMask 2         检测 Ctrl 的标记。
fmAltMask 4         检测 Alt 的标记。

MouseDown 或者 MouseUp 事件过程规定了按下或释放鼠标按键时应执行的动作。MouseDown 和 MouseUp 事件能够区别鼠标的左、右、中按钮。也可以为使用 Shift、Ctrl 和 Alt 键盘组合键的鼠标—键盘组合编写代码。
如果在鼠标指针在窗体或控件上时按下鼠标按键,该对象“捕捉”鼠标并接收所有的鼠标事件,直到并包含最后的 MouseUp 事件。这意味着鼠标事件返回的鼠标指针的 X,Y 坐标不会总在接收这些事件的对象的边界之内。
如果鼠标按键被连续按下,捕捉鼠标的对象接收所有连续的鼠标事件,直到所有的按键被释放。
用 Shift 参数标识在 MouseDown 或 MouseUp 事件发生时 Shift、Ctrl 和 Alt 的状态。例如,如果 Ctrl 和 Alt 被同时按下,则 Shift 的值为 6。

(6)MouseMove 事件
    用户移动鼠标时该事件发生。语法
Private Sub object_MouseMove( ByVal Button As fmButton, ByVal Shift As fmShiftState, ByVal X As Single, ByVal Y As Single)

MouseMove 事件的语法包含以下成分:
成分                 说明
object 必需。一个有效的对象名。
Button 必需。标识鼠标按键状态的整数值。
Shift 必需。指定 Shift 、Ctrl 和 Alt 的状态。
X, Y 必需。水平和垂直位置坐标,以磅为单位,从控件的左边或顶边开始测量。

Button 的设置如下:
值         说明
0 按键未被按下。
1 按下左键。
2 按下右键。
3 同时按下左键和右键。
4 按下中键。
5 同时按下左键和中键。
6 同时按下中键和右键。
7 三个按键全都按下。

Shift 的设置如下:
值 说明
1 按下 Shift。
2 按下 Ctrl。
3 同时按下 Shift 和 Ctrl。
4 按下 Alt。
5 同时按下 Alt 和 Shift。
6 同时按下 Alt 和 Ctrl。
7 同时按下 Alt、Shift 和 Ctrl。

用于标识各键盘组合键的常量:
常量 值 说明
fmShiftMask 1 检测 Shift 的标记。
fmCtrlMask 2 检测 Ctrl 的标记。
fmAltMask 4 检测 Alt 的标记。

MouseMove 事件用于窗体、窗体上的控件和标签。
当鼠标指针在对象上移动时,MouseMove 事件连续发生。只要鼠标位于对象的边界之内,对象就会不断识别 MouseMove 事件,直至其他对象“捕捉”到了鼠标为止。
移动窗体也能产生 MouseMove 事件,即使鼠标是静止的。当窗体在箭头的下移动时,便会产生 MouseMove 事件。如果一个宏或者事件过程通过移动窗体以响应 MouseMove 事件,则该事件会连续产生(级联的)MouseMove 事件。
如果两个控件靠得很近,且很快将鼠标指针移过两控件之间的空间,则对于该空间 MouseMove 事件可能不会发生。在这种情况下,就可能需要在两个控件中响应 MouseMove 事件。
可用 Button 参数返回的值标识鼠标按键的状态。
用 Shift 参数标识 MouseMove 事件发生时的 Shift、Ctrl 和 Alt 的状态。例如,同时按下 Ctrl 和 Alt 时,Shift 的值为 6。
注意:可用 MouseDown 和 MouseUp 事件过程响应按下和释放鼠标按键引起的事件。


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:16 | 显示全部楼层
本帖最后由 ivccav 于 2018-12-14 22:29 编辑


2.运用:Listbox控件运用举例

2.1、Listbox引用工作表数据

引用工作表数据需要使用RowSource属性,其值等于所引用单元格地址的字符串。使用RowSource绑定数据之后,Listbox列表是不可编辑的(但可显示标题),应用不大。纵览Listbox所有属性和方法,我想不出有什么好的应用价值,姑且想出了一个可有可无的功能,就是查找符合条件的一条项目,并首行显示之。
新建一个窗体,加入一个Listbox控件,一个标签,一个文本框,两个控制按钮。如果还不会添加,可以看下图,把鼠标放在工具箱上的各种图标上边,会有文字提示:

2-1-1.png
2-1-2.png

添加完控件之后,复制如下代码到窗体中:
Private Idx As Long '记录上次查询到的位置

Private Sub CommandButton1_Click() '下一条
    FindNextItem
End Sub

Private Sub CommandButton2_Click() '上一条
    FindPreviousItem
End Sub

Private Sub TextBox1_Change()
    Idx = 0
    FindNextItem
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .Font.Size = 10 '设置字体
        .ForeColor = vbBlue '字体颜色
        .RowSource =Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row).Address '引用工作表区域,为单元格地址字符串
        .ColumnHeads = True '是否显示标题,设置RowSource时有效,注意数据区域地址不包含标题行在内
        .ColumnCount = Range("a1").CurrentRegion.Columns.Count '显示的列数
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0" '设置每列列宽,宽度为0时隐藏该列
    End With
End Sub

Private Sub FindNextItem()
    With ListBox1
        Idx = Idx + 1
        If Idx < 0 Then Idx = 0
        If Idx >= .ListCount Then Exit Sub
        For i = Idx To .ListCount - 1
            If InStr(.List(i, 2), TextBox1) Then
                .ListIndex = i
                .TopIndex = i
                Exit For '绑定数据源的Listbox无法修改,查询到一项即可
            End If
            Idx = i
        Next
    End With
End Sub

Private Sub FindPreviousItem()
    With ListBox1
        Idx = Idx - 1
        If Idx < 0 Then Exit Sub
        If Idx >= .ListCount Then Idx = .ListCount - 1
        For i = Idx To 0 Step -1
            If InStr(.List(i, 2), TextBox1) Then
                .ListIndex = i
                .TopIndex = i
                Exit For
            End If
        Next
        Idx = i
    End With
End Sub
这样窗体就可以使用了,除了显示“上一条”和“下一条”按钮的代码比较复杂一些,其他都很简单。

2.2、Listbox引用数组数据和模糊查询

使用RowSource属性绑定数据之后,Listbox的列表是无法编辑的,而该控件的功能又很有限,比如筛选功能都是没有的,假如列表中有很多数据,要想快速找出来,还是有些困难的。使用控件的List属性来赋值,则可以随意添加或移除列表框的任何一行数据,筛选功能也变得可能。要说遗憾,就是标题不能用了,标题可以用标签自己在窗体上画吧,或者使用数据的第一行作为标题,或者干脆不要标题,如果还不行,就只能使用Listview控件了。
在窗体中输入如下代码,即可把数组的值整体一次性赋值给Listbox,例如在窗体初始化时的代码。想要模糊查询(或筛选),只需要在TextBox1_Change中增加几行代码即可,使用的是Listbox控件的AddItem方法,你也可以另定义一个数组,把匹配的结果放在该数组中,查询完毕之后,用List一次性赋值输出。注意赋值之前要Clear,否则数据会越来越多。关于如何查询,可参考帖子:http://club.excelhome.net/thread-1450458-1-1.html,该帖不仅讲了很多种查询的方法,还讲到了查询的效率问题,包括分页显示的技术。查询的结果集很大的时候,Listbox的显示输出是很慢的,有必要分页显示。

Private arr '存放数据的数组
Private Sub TextBox1_Change()
    Dim i&, j&, k&
    With ListBox1
        .Clear
        For i = 1 To UBound(arr) '多条件模糊查询,只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行,行号、列号都从0开始算
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
                k = k + 1 '记录行号
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue
        .ColumnCount = 12
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr '一次性赋值给Listbox控件
    End With
End Sub



评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:17 | 显示全部楼层


2.3、Listbox如何显示“标题”

要是Listbox中的列很多,用户就很难搞清楚该列到底是什么数据,这时还得有必要加个标题。上面说了,使用了List属性,就没法使用标题了,只能用标签在窗体上标注出来,或者在列表的第一行显示标题。用标签的方式很简单,用鼠标拖几个标签即可,我说说在列表的第一行显示标题的方法。
为了在第一行插入标题,得注意两个问题,一个是不能单击选中它,另一个是双击输出的时候得判断是不是第一行。还需要注意的是如果Listbox控件中已有数据,是不可以再使用List属性一次性赋值的,这就需要在用List赋值后使用AddItem( , -1)在第一行数据之前插入标题。代码修改如下:
Private arr '存放数据的数组
Private brr '存放标题的数组
Private Sub ListBox1_Click()
    With ListBox1
        If .ListIndex = 0 Then .ListIndex = - 1
    End With
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&
    With ListBox1
        i = .TopIndex + Y \ .Font.Size
        If i < .ListCount Then .ListIndex =i
    End With
End Sub

Private Sub TextBox1_Change()
    Dim i&, j&, k&
    With ListBox1
        .Clear
        .AddItem '添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
        For i = 1 To UBound(arr) '多条件模糊查询,只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行,行号、列号都从0开始算
                k = k + 1 '记录行号
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    brr = Range("a1:L1")
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue
        .ColumnCount = 12
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr '一次性赋值给Listbox控件。不能先AddItem,否则出错
        .AddItem , -1 '在第一行之前添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
    End With
End Sub
注意,MouseMove中的代码是让鼠标滑过时,让鼠标所在行高亮的代码TopIndex是列表中可见的第一行索引,Y\Font.Size是偏移量,因为鼠标光标的坐标(X,Y)和字体大小的单位都是磅,“\”是取整运算符,Y\Font.Size的结果就是偏移可见区首行的偏移量(字体大小约等于行高),两者之和大致是鼠标光标所在行索引。这个方法计算出来的仅仅是大概值,光标所在行偏离首行越远就越不准,在行数较少时是没有问题的。

2.4、Listbox支持鼠标滚动键

因为Listbox历史悠久,是不支持鼠标滚动键的(那时的鼠标应该还没有滚动键),有些人可能会觉得使用诸多不便。其实有一个简单的方法可用,即先选中一行数据,然后按住鼠标左键,上下拖动鼠标,就可以上下翻滚数据行了。是不是很简单,有种想说一句“So Easy!哪里不会点哪里”的冲动?
如果还是想要“正宗”的鼠标滚动键,还是有办法的,就有非常纠结的网友查阅各种洋文资料,搅鼓出了鼠标钩子的代码,试用了下,挺可以的,原贴地址:http://club.excelhome.net/thread-1259440-1-1.html,感谢分享,模块中的代码如下:

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean
Public LISTBOX_Post_Flag As Integer
Public LISTBOX_Mouse_Flag As Integer

Sub HookListBoxScroll()
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI
    GetCursorPos tPT
    hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
    If mListBoxHwnd <> hwndUnderCursor Then
        UnhookListBoxScroll
        mListBoxHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
        PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
        End If
    End If
End Sub

Sub UnhookListBoxScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mListBoxHwnd = 0
        mbHook = False
    End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
    On Error GoTo errH
    If (nCode = HC_ACTION) Then
        If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
            If wParam = WM_MOUSEWHEEL Then
                MouseProc = True
                If lParam.hwnd > 0 Then
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 1 Then frm.ListBox1.TopIndex = frm.ListBox1.TopIndex - 1
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 2 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
                Else
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 1 Then frm.ListBox1.TopIndex = frm.ListBox1.TopIndex + 1
                    If LISTBOX_Post_Flag = 1 And LISTBOX_Mouse_Flag = 2 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
                End If
                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                Exit Function
            End If
        Else
            UnhookListBoxScroll
        End If
    End If
    MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookListBoxScroll
End Function

窗体中的代码如下:

Private arr '存放数据的数组
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookListBoxScroll
End Sub

Private Sub OptionButton1_Click()
    LISTBOX_Mouse_Flag = 1
End Sub

Private Sub OptionButton2_Click()
    LISTBOX_Mouse_Flag = 2
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    UnhookListBoxScroll
End Sub

Private Sub TextBox1_Change()
    Dim i&, j&, k&
    With ListBox1
        .Clear
        For i = 1 To UBound(arr) '多条件模糊查询,只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行,行号、列号都从0开始算
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
                k = k + 1 '记录行号
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    LISTBOX_Post_Flag = 1
    LISTBOX_Mouse_Flag = 1
    OptionButton1 = True
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue
        .ColumnCount = 12
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr
    End With
End Sub

经过试验,在工作表中的Listbox控件(ActiveX)也可使用这个钩子。工作表的Listbox控件也有ListBox1_MouseMove事件,可在该事件中直接调用:HookListBoxScroll。工作表中没有UserForm_QueryClose,可以在控件失焦事件ListBox1_LostFocus()中调用UnhookListBoxScroll即可。




补充内容 (2020-12-6 19:56):
在工作表中让Listbox支持鼠标滚动键,可见141楼:http://club.excelhome.net/thread-1451605-15-1.html

评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:18 | 显示全部楼层


2.5、Listbox多选功能和数据导出

Listbox是支持多选功能的,需要在列表框中选择多项数据时特别有用。注意Listbox设置为多选时,无法使用_Click事件,需要改用_Change事件。需用程序控制第一行标题行不让选中,当然,也可以利用.Selected(0)的值(标题行的选框是否选中)来实现整个列表的全选和全不选功能,只要循环整个列表,并用Selected(i)=Selected(0)设置即可。代码中已有注释,不再赘叙。
Private arr '存放数据的数组
Private brr '存放标题的数组
Private cnt& '记录已选中行数

Private Sub CommandButton1_Click()
'数据输出,输出已经选中的数据
'先保存到数组中再一次性输出效率高
'如果要保存标题,drr行数多定义1行
'Selected(i) = True表示已选中该行
Dim drr, i&, j&, k&
    ReDim drr(1 To cnt, 1 To 12)
    With ListBox1
    If .ListCount < 2 Then Exit Sub
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            k = k + 1
            For j = 1 To 12
                drr(k, j) = .List(i, j - 1)
            Next
        End If
    Next
    End With
    Sheet2.Activate
    Cells.ClearContents
    Range("a1").Resize(UBound(drr, 1), UBound(drr, 2)) = drr
End Sub

Private Sub ListBox1_Change()
'多选时无法使用_Click事件
'不能按住鼠标左键拖动选择
'也可以利用.Selected(0)的值(标题行的选框)来进行整个列表的全选和全不选,
'只要循环整个列表,并用Selected(i)=Selected(0)设置即可
    With ListBox1
        If .Selected(0) = True Then .Selected(0) = False '不让选中第一行
        If .ListIndex > 0 Then '从第二行开始,如果选中就计数
            If .Selected(.ListIndex) = True Then cnt = cnt + 1 Else cnt = cnt - 1
        End If
        Label2 = "已选中" & cnt & "条记录"
    End With
End Sub

Private Sub TextBox1_Change() '模糊查询
    Dim i&, j&, k&
    With ListBox1
        .Clear '清除列表
        .AddItem '添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
        For i = 1 To UBound(arr) '多条件模糊查询,只需把各列串联起来即可。
            If InStr(arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5), TextBox1) Then
                .AddItem '在列表末尾添加一个空行,行号、列号都从0开始算
                k = k + 1 '记录行号
                For j = 1 To UBound(arr, 2)
                    .List(k, j - 1) = arr(i, j)
                Next
            End If
        Next
    End With
End Sub

Private Sub UserForm_Initialize()
    arr = Range("a2:L" & Range("a" & Rows.Count).End(xlUp).Row)
    brr = Range("a1:L1")
    With ListBox1
        .Font.Size = 10
        .ForeColor = vbBlue '字体颜色
        .BackColor = 14545386 '背景色
        .ColumnCount = 12
        .MultiSelect = fmMultiSelectMulti
        .ListStyle = fmListStyleOption
        .ColumnWidths = "0;80;100;100,100,60;60,60,100,0,0,0"
        .List = arr '一次性赋值给Listbox控件,不能先AddItem,否则出错
        .AddItem , -1  '在第一行之前添加标题
        For j = 1 To UBound(brr, 2): .List(0, j - 1) = brr(1, j): Next
        Label2 = "就绪"
    End With
End Sub
多次查询还保留已选项目的代码我在Listview教程中已写过,可直接改一下即可,这里不想再重复,帖子中第四节“Listview窗体不重复多选的实现”有完整说明了:http://club.excelhome.net/thread-1424969-1-1.html


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:22 | 显示全部楼层


2.6、在工作表中使用Listbox实现逐步提示输入功能

这里说一下用Listbox控件在工作表上做辅助智能输入。这个问题在论坛上总是经常有人问,而分享过代码的人也很多,随便搜一下就有几十上百个,但奇怪的是,问了答,答了又问,就这么一直循环下去。其实这问题很简单,思路也不复杂:因为Listbox没有输入框,单元格又没有即时查询功能,就用TextBox文本框覆盖在活动单元格上面,通过TextBox的Change事件不停地查询,并把符合查询条件的数据显示到Listbox列表框中,然后通过TextBox和Listbox的按键事件监测方向键、回车键等按键输入对列表框选项进行选择和输出。这就完了。具体的步骤也很少:
(1)在工作表中插入一个TextBox和Listbox控件(ActiveX)。
(2)在工作表Worksheet_SelectionChange事件中检查是否该显示以上两个控件,如果需要显示,就用Visible显示出来。显示条件可以是单元格区域,也可以是自己定义的辅助输入的开关子过程,说白了就是定义一个布尔值的变量,或者利用用Application.EnableEvents禁用、启用工作表事件。开关子过程还可以设置一个快捷键,点“开发工具”——“宏”——“选项”就可以设置,也可以用方法Application.MacroOptions设置。数据放在数组中效率高,因此还可以定义一个子过程获取数据,作为一个准备条件进行检查。全部条件符合就显示那两个控件。这个步骤中唯一要注意的是Listbox控件需要设置一些属性。
(3)控件显示之后,用TextBox1_Change事件不断查询数据并输入到Listbox中,以供选择。
(4)Listbox控件显示数据之后,如果用鼠标选择并输出数据,直接用其单击和双击事件就好了,很简单。如果还想搞个纯键盘输入,可以在这两个控件的KeyUp事件中监测键入值。为什么两个控件都要KeyUp呢,我们是在Textbox中输入查询内容,当然要KeyUp,但如果用户用鼠标点击Listbox,让其获得了焦点,也得有相同的体验吧?两个控件的KeyUp写成一样就行了。纯键盘输入方法也不要搞得很复杂,不然使用者记不住,或者觉得太难记,会抵触使用的。就设定成:上下方向键选择列表项,选好后按回车键输入到工作表,按CTRL+方向键从当前单元格跳跃到同箭头方向的下一个单元格,CTRL+W开\关辅助输入功能,CTRL+R刷新数据源(应该用得少),Tab键取消查询(ESC键貌似不响应),上下方向键在Textbox文本之间移动(这个无需设置,本来的功能),这样就可以了,符合原有使用习惯最好。
(5)按回车之后输入数据到工作表可以写个子过程,处理输入完成之后,单元格怎么走。
代码完成之后,懂了原理之后,以后要改,就很简单了,基本上就是查询部分改一下,输出部分改一下,准备工作改一下,几十分钟就能改好了。
提供我写好的代码给大家参考,有注释。
对应工作表对象中的代码:
Private Original$ '存储目标单元格原始值
Private ListIdx& '存储列表框按下方向键而尚未弹起时的行索引值
Private Const RangeAddr = "D2:D65536,F2:F65536" '设置作用区域

Private Sub HideCtrl()
    '隐藏控件,到处需要使用,做出公共过程
    ListBox1.Clear
    TextBox1 = ""
    ListBox1.Visible = False
    TextBox1.Visible = False
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    '为什么要记录ListIdx?是因为在ListBox1按住上、下箭头无需弹起也能滚动列表(持续触发KeyDown)
    '不在按下方向键时标记ListIdx,KeyUp按键弹起事件中就会多走一定数量的行。
    ListIdx = ListBox1.ListIndex
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    ListIdx = ListBox1.ListIndex
End Sub

Private Sub Ctrl_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    '因为Listbox和TEXTBOX控件都要用到这个事件,故定义一个公共子过程
    'Shift值:0代表没有按3键中的任何一个,1代表按了Shift键,2代表按了Ctrl键,4代表按了ALT
    Dim lRow&, lCol&, i&
    With ListBox1
        Select Case KeyCode
            Case vbKeyReturn '按回车键,完成输入动作
                WriteInto

            Case vbKeyTab '按ESC键无法响应,改为Tab键,取消输入,恢复原值
                ActiveCell = Original
                HideCtrl

            Case vbKeyUp, vbKeyDown '上、下方向键
                If Shift = 2 Then 'Ctrl+上、下方向键,跳到当前活动单元格的上、下方单元格
                    With ActiveCell
                        Do
                            i = i + KeyCode - 39 '↑、↓键码为38、40,KeyCode - 39 = ±1
                            lRow = .Row + i
                            If lRow < 1 Or lRow > Rows.Count Then Exit Do '超出工作表行数范围
                            If Rows(lRow).Height Then .Offset(i).Activate: Exit Do '隐藏行高为0
                        Loop
                    End With
                ElseIf .ListCount > 2 Then 'Listbox中有数据行时
                    ListIdx = ListIdx + KeyCode - 39
                    If ListIdx <= 0 Then ListIdx = .ListCount - 1 '选中第一行标题时变成选最后一行
                    If ListIdx >= .ListCount Then ListIdx = 1 '超过最后一行后返回到第二行(第一行为标题)
                    .ListIndex = ListIdx
                End If

            Case vbKeyLeft, vbKeyRight '左、右方向键
                If Shift = 2 Then 'ActiveCell.Offset(, KeyCode - 38).Activate
                    With ActiveCell
                        Do
                            i = i + KeyCode - 38 '←、→键码为37、39,KeyCode - 38 = ±1
                            lCol = .Column + i
                            If lCol < 1 Or lCol > Columns.Count Then Exit Do '超出工作表列数范围
                            If Columns(lCol).Width Then .Offset(, i).Activate: Exit Do '隐藏列宽为0
                        Loop
                    End With
                End If

            Case vbKeyW '快捷方式Ctrl+W开关辅助输入
                If Shift = 2 Then Call Switch

            Case vbKeyR '快捷方式Ctrl+R更新数据源数组
                If Shift = 2 Then Call GetData

            Case Else
        End Select
    End With
End Sub

Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Ctrl_KeyUp KeyCode, Shift
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Ctrl_KeyUp KeyCode, Shift
End Sub



Keycode常数表.zip (10.36 KB, 下载次数: 805)

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:24 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

接上楼

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '判断是否符合条件

    If InputSwitchFlag = False Then Exit Sub '不能用HideCtrl,事件中运行任何代码修改值或属性都会影响复制后的粘贴功能,
    '这句代码这样设置,InputSwitchFlag = False时不影响粘贴。如果用Application.EnableEvents = False会影响其他事件使用。
    '使用Application.CutCopyMode<>False也有问题,单元格编辑状态(双击)下复制无法探测。检测剪贴板上是否有内容也不完美。
    If Intersect(Target, Range(RangeAddr)) Is Nothing Then HideCtrl: Exit Sub
    If Target.Count > 1 Then HideCtrl: Exit Sub
    If IsEmpty(arr) Then Call GetData
    If IsEmpty(arr) Then HideCtrl: Exit Sub

    '初始化准备工作
    '设定控件的尺寸、位置、字体等 属性
    ListBox1.Visible = False
    TextBox1.Visible = False
    With TextBox1
        .Top = Target.Top
        .Left = Target.Left
        .Width = Target.Width
        .Height = Target.Height
        .Font.Size = Target.Font.Size - 1
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &H80000006
        .Text = ActiveCell.Value
        Original = .Text
        .Activate
        .Visible = True
    End With
    With ListBox1
        .Top = Target.Top + Target.Height + 2
        .Left = Target.Left + Target.Width
        .Height = 150
        .Width = 310
        .Font.Size = 10
        .ForeColor = vbBlue
        .BackColor = 15849925
        .ColumnCount = UBound(arr, 2)
        .ColumnWidths = "0;0;100;100;100;0;0;0;0;0;0;0"
        .Visible = True
    End With
    TextBox1_Change
End Sub

Private Sub WriteInto() '填入内容到工作表
    Dim brr
    With ListBox1
        If .ListCount < 2 Then '没有查询到数据,直接输入TextBox1内容
            ActiveCell = TextBox1.Text
        Else
            If .ListIndex = 0 Then Exit Sub
            ReDim brr(1 To .ColumnCount)
            For i = 1 To UBound(brr)
                brr(i) = .List(.ListIndex, i - 1)
            Next
            ActiveCell.Resize(1, UBound(brr)) = brr
        End If
        TextBox1.Text = ""
        ActiveCell.Offset(1).Activate

        'SmallScroll可有四个参数:
        'Down 将内容向下滚动的行数。
        'Up 将内容向上滚动的行数。
        'ToRight 将内容向右滚动的列数。
        'ToLeft 将内容向左滚动的列数。
        ActiveWindow.SmallScroll Down:=1
    End With
End Sub

Private Sub TextBox1_Change()
    Dim s$, t$, i&, j&, u&, brr
    If IsEmpty(arr) Then Exit Sub
    t = UCase(TextBox1)
    With ListBox1
        If Len(t) = 0 Then
            .List = arr
            .ListIndex = 1
            Exit Sub
        End If

        ReDim brr(1 To UBound(arr, 2), 1 To 1)
        For i = 1 To UBound(arr, 2) '标题
            brr(i, 1) = arr(1, i)
        Next
        .Clear
        For i = 2 To UBound(arr)
            s = arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5)
            If InStr(s, t) Then
                ReDim Preserve brr(1 To UBound(arr, 2), 1 To UBound(brr, 2) + 1)
                u = UBound(brr, 2)
                For j = 1 To UBound(arr, 2) '想显示几列就赋值几列
                    brr(j, u) = arr(i, j)
                Next
            End If
        Next
        .Column = brr '用Column属性赋值无需转置数组
        If UBound(brr, 2) > 1 Then .ListIndex = 1
    End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    WriteInto
End Sub
   模块中的代码:

Public InputSwitchFlag As Boolean
Public arr ' 该数组保存原始数据

Sub GetData()
    arr = Sheet1.Range("a1").CurrentRegion
End Sub

Sub Switch() '切换辅助输入状态
    InputSwitchFlag = Not InputSwitchFlag
    If InputSwitchFlag = False Then
        With ActiveSheet
            If .CodeName = "Sheet2" Then
                ActiveSheet.ListBox1.Visible = False
                ActiveSheet.TextBox1.Visible = False
            End If
        End With
        MsgBox "已关表辅助输入状态!"
    Else
        MsgBox "已开启辅助输入状态!"
    End If
End Sub

Sub SwitchShortcutKey()
    '设置切换输入形式的快捷键:ctrl+W
    Application.MacroOptions Macro:="Switch", HasShortcutKey:=True, ShortcutKey:="w"
End Sub

附件中还有一个用Listview代替Listbox的辅助输入代码,大家可根据自己喜好选择控件吧。Listview功能强大,但加载也稍微慢些,怎么使用就不讲了,看教程:http://club.excelhome.net/thread-1424969-1-1.html
这样就可以了。最重要的是多练习一下(如多答题),还有多看看别人写的代码,毕竟大家都不是专业的,精力有限,没可能专研大部头,只能用业余闲散时间看看别人的代码,也许能学到点新想法呢。ActiveWindow.SmallScroll即是我偶然中看到别人代码中用到的,我觉得这个功能很好,就在以上代码中使用了。


——END——

评分

9

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-14 22:31 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-12-15 06:14 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-15 12:57 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
listbox功能少,但是相比listview,兼容性好,运行更快,其一次性赋值的属性似乎也更有效率。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-23 01:51 , Processed in 0.043790 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表