VBA之Listbox控件基础教程

青山雨雾

强强强，实在太有用了

有哥

老师，按照你的代码，照葫芦画瓢用了起来，现在有五百多条记录，今后还会更多，每次在模糊查询时在查询输入框点撤销按钮时，都卡的很。所以我用了一个清空按钮来代替撤销按钮。这种卡顿是通病还是我的代码有问题呢。这段代码还能优化提高查询速度吗？怎么优化呢？




能不能帮我实现这个功能，在这个查询窗口增加一个输入框和一个修改按钮，当点击某条数据后，我可以点击修改把我需要的车牌号，重新赋予覆盖到这条数据里。

pjoil

好贴，留个爪。

506981919

花了一晚上，从头到尾看回复，下载看编写，终于学以致用。谢谢老师

xuminglei2003

学习中，强大

唐朝123

学习了，非常有用。
因为Listbox的兼容性很强，所以经常用。

tzgwh

重新系统的再学习一次

从此海蓝

1. 
   
2. Private Original$ '存储目标单元格原始值
   
3. Private ListIdx& '存储列表框按下方向键而尚未弹起时的行索引值
   
4. Private Const RangeAddr = "E4" '设置作用区域
   
5. 
   
6. Private Sub HideCtrl()
   
7.     '隐藏控件，到处需要使用，做出公共过程
   
8.     ListBox1.Clear '清空列表
   
9.     TextBox1 = "" '文本框为空
   
10.     ListBox1.Visible = False '隐藏列表框
    
11.     TextBox1.Visible = False '隐藏文本框
    
12. End Sub
    
13. 
    
14. Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
15.     '为什么要记录ListIdx？是因为在ListBox1按住上、下箭头无需弹起也能滚动列表(持续触发KeyDown)
    
16.     '不在按下方向键时标记ListIdx，KeyUp按键弹起事件中就会多走一定数量的行。
    
17.     ListIdx = ListBox1.ListIndex
    
18. End Sub
    
19. 
    
20. Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
21.     ListIdx = ListBox1.ListIndex
    
22. End Sub
    
23. 
    
24. Private Sub Ctrl_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
25.     '因为Listbox和TEXTBOX控件都要用到这个事件，故定义一个公共子过程
    
26.     'Shift值：0代表没有按3键中的任何一个，1代表按了Shift键，2代表按了Ctrl键，4代表按了ALT
    
27.     Dim lRow&, lCol&, i&
    
28.     With ListBox1
    
29.         Select Case KeyCode
    
30.             Case vbKeyReturn '按回车键，完成输入动作
    
31.                 WriteInto
    
32.                
    
33.             Case vbKeyTab '按ESC键无法响应，改为Tab键，取消输入，恢复原值
    
34.                 ActiveCell = Original
    
35.                 HideCtrl
    
36.                
    
37.             Case vbKeyUp, vbKeyDown '上、下方向键
    
38.                 If Shift = 2 Then 'Ctrl+上、下方向键，跳到当前活动单元格的上、下方单元格
    
39.                     With ActiveCell
    
40.                         Do
    
41.                             i = i + KeyCode - 39 '↑、↓键码为38、40，KeyCode - 39 = ±1
    
42.                             lRow = .Row + i
    
43.                             If lRow < 1 Or lRow > Rows.Count Then Exit Do '超出工作表行数范围
    
44.                             If Rows(lRow).Height Then .Offset(i).Activate: Exit Do '隐藏行高为0
    
45.                         Loop
    
46.                     End With
    
47.                 ElseIf .ListCount > 2 Then 'Listbox中有数据行时
    
48.                     ListIdx = ListIdx + KeyCode - 39
    
49.                     If ListIdx <= 0 Then ListIdx = .ListCount - 1 '选中第一行标题时变成选最后一行
    
50.                     If ListIdx >= .ListCount Then ListIdx = 1 '超过最后一行后返回到第二行（第一行为标题）
    
51.                     .ListIndex = ListIdx
    
52.                 End If
    
53.                
    
54.             Case vbKeyLeft, vbKeyRight '左、右方向键
    
55.                 If Shift = 2 Then 'ActiveCell.Offset(, KeyCode - 38).Activate
    
56.                     With ActiveCell
    
57.                         Do
    
58.                             i = i + KeyCode - 38 '←、→键码为37、39，KeyCode - 38 = ±1
    
59.                             lCol = .Column + i
    
60.                             If lCol < 1 Or lCol > Columns.Count Then Exit Do '超出工作表列数范围
    
61.                             If Columns(lCol).Width Then .Offset(, i).Activate: Exit Do '隐藏列宽为0
    
62.                         Loop
    
63.                     End With
    
64.                 End If
    
65.             Case Else
    
66.         End Select
    
67.     End With
    
68. End Sub
    
69. 
    
70. Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
71.     Ctrl_KeyUp KeyCode, Shift
    
72. End Sub
    
73. 
    
74. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
75.     Ctrl_KeyUp KeyCode, Shift
    
76. End Sub
    
77. 
    
78. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
79.     '判断是否符合条件
    
80. 
    
81.     'If InputSwitchFlag = False Then Exit Sub '不能用HideCtrl，事件中运行任何代码修改值或属性都会影响复制后的粘贴功能，
    
82.     '这句代码这样设置，InputSwitchFlag = False时不影响粘贴。如果用Application.EnableEvents = False会影响其他事件使用。
    
83.     '使用Application.CutCopyMode<>False也有问题，单元格编辑状态（双击）下复制无法探测。检测剪贴板上是否有内容也不完美。
    
84.     If Intersect(Target, Range(RangeAddr)) Is Nothing Then HideCtrl: Exit Sub
    
85.     If Target.Count > 1 Then HideCtrl: Exit Sub
    
86.     If IsEmpty(arr) Then Call GetData
    
87.     If IsEmpty(arr) Then HideCtrl: Exit Sub
    
88.    
    
89.     '初始化准备工作
    
90.     '设定控件的尺寸、位置、字体等 属性
    
91.     ListBox1.Visible = False
    
92.     TextBox1.Visible = False
    
93.     With TextBox1
    
94.         .Top = Target.Top
    
95.         .Left = Target.Left
    
96.         .Width = Target.Width
    
97.         .Height = Target.Height
    
98.         .Font.Size = Target.Font.Size - 1
    
99.         .BorderStyle = fmBorderStyleSingle
    
100.         .BorderColor = &H80000006
     
101.         .Text = ActiveCell.Value
     
102.         Original = .Text
     
103.         .Activate
     
104.         .Visible = True
     
105.     End With
     
106.     With ListBox1
     
107.         .Top = Target.Top + Target.Height + 2
     
108.         .Left = Target.Left + Target.Width
     
109.         .Height = 200 '高度
     
110.         .Width = 600 '宽度
     
111.         .Font.Size = 10
     
112.         .ForeColor = vbBlue
     
113.         .BackColor = 15849925
     
114.         .ColumnCount = UBound(arr, 2) ' '列表框的列数=数组的列数
     
115.         .ColumnWidths = "80;80;80;50;50;50;50;50;50;50;50;50"
     
116.         .Visible = True
     
117.     End With
     
118.     TextBox1_Change
     
119. End Sub
     
120. 
     
121. 
     
122. Private Sub WriteInto() '填入内容到哦工作表
     
123.     Dim brr
     
124.     With ListBox1
     
125.         If .ListCount < 2 Then '没有查询到数据，直接输入TextBox1内容
     
126.             ActiveCell = TextBox1.Text
     
127.         Else
     
128.             If .ListIndex = 0 Then Exit Sub
     
129.             ReDim brr(1 To .ColumnCount)
     
130.             For i = 2 To UBound(brr)
     
131.                 brr(i) = .List(.ListIndex, i - 1)
     
132.             Next
     
133.             ActiveCell.Resize(1, UBound(brr)) = brr
     
134.         End If
     
135.         TextBox1.Text = ""
     
136.         'ActiveCell.Offset(1).Activate
     
137.         
     
138.         'SmallScroll可有四个参数：
     
139.         'Down 将内容向下滚动的行数。
     
140.         'Up 将内容向上滚动的行数。
     
141.         'ToRight 将内容向右滚动的列数。
     
142.         'ToLeft 将内容向左滚动的列数。
     
143.         'ActiveWindow.SmallScroll Down:=1
     
144.     End With
     
145. End Sub
     
146. 
     
147. 
     
148. 
     
149. Private Sub TextBox1_Change()
     
150.     Dim s$, t$, i&, j&, u&, brr
     
151.     If IsEmpty(arr) Then Exit Sub
     
152.     t = UCase(TextBox1)
     
153.     With ListBox1
     
154.         If Len(t) = 0 Then
     
155.             .List = arr
     
156.             .ListIndex = 1
     
157.             Exit Sub
     
158.         End If
     
159.    
     
160.         ReDim brr(1 To UBound(arr, 2), 1 To 1) '定义二维数组brr，1到数组的列数
     
161.         For i = 2 To UBound(arr, 2) '标题 ''UBound(brr, 2)数组的列数表达
     
162.             brr(i, 1) = arr(2, i)
     
163.         Next
     
164.         .Clear
     
165.         For i = 2 To UBound(arr) '数组的行数的表达,
     
166.             s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5) '多条件模糊查询，只需把各列串联起来即可。
     
167.             If InStr(s, t) Then
     
168.                 ReDim Preserve brr(1 To UBound(arr, 2), 1 To UBound(brr, 2) + 1) 'UBound(brr, 2)数组的列数表达
     
169.                 u = UBound(brr, 2) 'UBound(brr, 2)数组的列数表达
     
170.                 For j = 1 To UBound(arr, 2) '想显示几列就赋值几列
     
171.                     brr(j, u) = arr(i, j)
     
172.                 Next
     
173.             End If
     
174.         Next
     
175.        .Column = brr '用Column属性赋值无需转置数组
     
176.         If UBound(brr, 2) > 1 Then .ListIndex = 1
     
177.     End With
     
178. End Sub
     
179. 
     
180. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
     
181.     WriteInto
     
182. End Sub
     
183. 
     

复制代码

@ivccav 请问向图片中的双标题行如果修改呢？有一个是数据源表的总标题，第4行才是数据源的标题行。。

hai1380

请教两个问题：1 listbox如何设置水平滚动条？当一行文字过多显示不全问题如何解决；2 类似控件的详细文档，在微软官网上哪里可以查到？ 谢谢

zanghow6

强！学习了