ListBox条件赋值

jinri01

需求：鼠标在C3时显示Listbox，并且将A14：Range("b65535").End(xlUp).Row

的数据区中，科目编码前4位数等于C3的科目编码和科目名称值赋给Listbox 会计科目.rar (8.18 KB, 下载次数: 65) 2013-3-12 08:42 上传 点击文件名下载附件

蓝桥玄霜

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. Dim Myr&, Arr, i&, Arr1, j&
   
4. If Target.Address = "$C$3" Then
   
5.     Myr = [a65536].End(xlUp).Row
   
6.     Arr = Range("a15:b" & Myr)
   
7.     ReDim Arr1(1 To UBound(Arr), 1 To 2)
   
8.     j = j + 1
   
9.     Arr1(1, 1) = "科目代码": Arr1(1, 2) = "科目名称"
   
10.     For i = 1 To UBound(Arr)
    
11.         If Left(Arr(i, 1), 4) = CStr(Target.Value) Then
    
12.             j = j + 1
    
13.             Arr1(j, 1) = Arr(i, 1): Arr1(j, 2) = Arr(i, 2)
    
14.         End If
    
15.     Next
    
16.     With Me.ListBox1
    
17.         .Visible = True
    
18.         .Top = [c4].Top
    
19.         .Left = [d3].Left
    
20.         .ColumnCount = 2
    
21.         .ColumnWidths = "60,50"
    
22.         .Clear
    
23.         .List = Arr1
    
24.     End With
    
25. Else
    
26.     Me.ListBox1.Visible = False
    
27. End If
    
28. End Sub
    

复制代码

Zamyi

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Address = "$C$3" Then
   
3.   ListBox1.ColumnCount = 2
   
4.   ListBox1.List = Range("a14", [b65535].End(xlUp)).Value
   
5. End If
   
6. End Sub
   

复制代码

蓝桥玄霜

请见附件。

李甲

ListBox1.ColumnCount = 2

jinri01

蓝桥玄霜 发表于 2013-3-12 09:28

非常谢谢蓝桥老师。另外，能否做到随着输入数据的变化Listbox实时动态变化显示吗？

lsdongjh

为了实现效果，给你增加了一个textbox
会计科目.rar (15.06 KB, 下载次数: 117)

2013-3-12 09:59 上传

点击文件名下载附件

1. 
   
2. Option Explicit
   
3. 
   
4. '双击listbox,将值赋给textbox以及E3
   
5. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
6.     Dim strT() As String
   
7.     If ListBox1.Text <> "" Then strT = Split(ListBox1.Text, "-")
   
8.     TextBox1.Text = strT(0)
   
9.     Range("E3").Value = strT(1)
   
10.    
    
11. End Sub
    
12. 
    
13. '根据文本框输入的值，自动更改列表框，以供选择
    
14. Private Sub TextBox1_Change()
    
15.     ListBox1.Clear
    
16.     Range("E3").Value = ""
    
17.    
    
18.     If Trim(TextBox1.Text) = "" Then Exit Sub
    
19.    
    
20.     Dim lngRows As Long
    
21.     Dim intLen As Integer
    
22.     Dim strFind As String
    
23.     Dim arr
    
24.     Dim lngI As Long
    
25.    
    
26.     lngRows = Range("A65536").End(xlUp).Row
    
27.     arr = Range("A15:B" & lngRows)
    
28.     strFind = Trim(TextBox1.Text)
    
29.     intLen = Len(strFind)
    
30.     For lngI = 1 To UBound(arr)
    
31.         If Mid(arr(lngI, 1), 1, intLen) = strFind Then
    
32.             ListBox1.AddItem arr(lngI, 1) & "-" & arr(lngI, 2)
    
33.         End If
    
34.     Next
    
35.    
    
36.     Range("C3").Value = TextBox1.Text
    
37.    
    
38. End Sub
    
39. 
    
40. '当焦点在C3时，显示文本框及列表框
    
41. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
42.   ListBox1.Visible = False
    
43.   TextBox1.Visible = False
    
44.   If Target.Address = "$C$3" Then
    
45.     TextBox1.Left = Range("C3").Left
    
46.     TextBox1.Top = Range("C3").Top
    
47.     TextBox1.Height = Range("C3").Height
    
48.     TextBox1.Width = Range("C3").Width
    
49.     TextBox1.Text = Range("C3").Value
    
50.     TextBox1.Visible = True
    
51.     TextBox1.Activate
    
52.    
    
53.     ListBox1.Visible = True
    
54.     ListBox1.Left = Range("C3").Left
    
55.     ListBox1.Top = Range("C3").Top + Range("C3").Height
    
56.   End If
    
57.   
    
58. End Sub

复制代码

jinri01

lsdongjh 发表于 2013-3-12 09:59
为了实现效果，给你增加了一个textbox

你好，谢谢你的帮助，请问能否修改下，按ENTER键，把输入文本框的编码赋值给C3，其它功能不变。

lsdongjh

jinri01 发表于 2013-3-12 10:51
你好，谢谢你的帮助，请问能否修改下，按ENTER键，把输入文本框的编码赋值给C3，其它功能不变。

不需要这个功能吧，已实现了：在文本框中输入时，同步更改C3;在列表框中双击时，同步更改C3

lsdongjh

有个小Bug,修正了一下