本类文章的标签为 ‘列表框’


在一个列表框中显示另一列表框中的具体内容

1 颗星2 颗星3 颗星4 颗星5 颗星 (目前还没有人投票)
Loading ... Loading ...

有时,需要选中某列表框的的项目后,在另一列表框中显示该项目的具体内容,如下图1所示。
listboxselect1
图1:两个列表框实现内容匹配
“专业工程”包括“建筑工程、装饰装修工程……”等,当选中项目列表框中的专业工程后,在分类列表框中显示相应的内容。同理,选择项目列表框中的措施项目后,在分类列表框中也会显示相应的内容。
第一步:准备数据
如下图2所示,在工作表Sheet1中输入下列数据。
listboxselect2
图2:基础数据
将A列的数据命名为“项目”,将B列的数据命名为“专业工程”,将C列的数据命名为“措施项目”。注意,B列和C列的名称应与A列的数据相一致。
第二步:准备窗体界面
如图1所示,在用户窗体中放置两个标签控件、两个列表框控件,并将两个列表框控件分别命名为lbxItem和lbxCategory。
第三步:输入代码
在用户窗体代码模块中,输入下列代码:

Private Sub lbxItem_Change()
    Dim rngCategory As Range
 
    Set rngCategory = Sheet1.Range(Me.lbxItem.Value)
 
    Me.lbxCategory.List = rngCategory.Value
End Sub
 
Private Sub UserForm_Initialize()
    Dim rngItem As Range
 
    Set rngItem = Sheet1.Range("项目")
 
    Me.lbxItem.List = rngItem.Value
End Sub

运行后的最终效果如图1所示。当然,您可以在A列添加更多的项目数据,然后在C列、D列……添加相应的内容并以A列的数据命名,从而扩展本实例。
(注:网站空间被删前的文章,有一定的学习意义,故找出来重新贴出之)

相关文章

快速搜索并辅助输入所需的数据

1 颗星2 颗星3 颗星4 颗星5 颗星 (目前还没有人投票)
Loading ... Loading ...

这是在EH中看到的一个贴子《求高手作一个数据输入窗口》,其要求为:

这个表是用来输入公司的采购数据的,为了输入的规范,便于把采购单价用公式导入计算销售的表格中,所以必须采用输菜编码的方式录入,但是菜编码太多,很难记住,特别是对于新员工,所以设计了简码,想实现动画图片那样的功能,请高手帮忙!!!
1、如果记得住菜号,在菜号单元格中输入菜号,在输的过程中能逐步提示,如附图动画。
2、如果记不住菜号,就在菜号单元格中输入简码,输入简码过程中能逐步提示,简码会有重复的菜名,按上下箭头能进行选择,输完回车后,显示的还是菜号,而不是简码,如附图动画。
3、如果能做成一个类似EXCEL中的记录单(如图:输单界面)的形式更好。

初步做了一下,实现的效果如下:
“采购录入信息”工作表:选择列A中的任意单元格或者双击列A中的任意单元格将弹出下图所示的输入对话框。
quickenterinfo1
在上方的文本框中输入菜号或者简码后,下方的列表框将自动搜索匹配的数据。
单击下方列表框中的数据后,相关数据将自动输入到“采购录入信息”工作表的列A和列B中,同时其它列的信息自动填充。
主要的程序代码如下:

Option Explicit
Dim varData, lOldLen
 
Private Sub UserForm_Initialize()
    Dim lLast As Long
    Dim rng As Range
 
    lLast = wksCP.Range("A" & Cells.Rows.Count).End(xlUp).Row
    varData = wksCP.Range("A2:C" & lLast)
 
    With Me.lbxInfo
        .BoundColumn = 1
        .ColumnCount = 3
        .List = varData
    End With
End Sub
 
Private Sub txtFind_Change()
    Dim i As Long
    Dim strFind As String
 
    strFind = "*" & UCase(Me.txtFind.Text) & "*"
 
    With Me.lbxInfo
        If Len(Me.txtFind.Text) < lOldLen Then
            .List = varData
        End If
        lOldLen = Len(Me.txtFind.Text)
        For i = .ListCount - 1 To 0 Step -1
            If (Not UCase(.List(i, 0)) Like strFind) And (Not UCase(.List(i, 2)) Like strFind) Then
                .RemoveItem i
            End If
        Next i
    End With
End Sub
 
Private Sub lbxInfo_Click()
    Dim lListIndex As Long
    lListIndex = Me.lbxInfo.ListIndex
    ActiveCell.Value = Me.lbxInfo.List(lListIndex, 0)
    ActiveCell.Offset(0, 1).Value = Me.lbxInfo.List(lListIndex, 2)
    Unload frmEnterInfo
End Sub
 
Private Sub btnClose_Click()
    Unload frmEnterInfo
End Sub

示例下载:

操作演示:

相关文章

仿Google输入框——快速查找列表框中的项目

1 颗星2 颗星3 颗星4 颗星5 颗星 (3 人投票, 平均: 4.33 out of 5)
Loading ... Loading ...

在使用Google搜索时,一般我们会在输入框中输入想要搜索的文本,此时下方会出现相关条目供选择,以方便快速输入。下面,我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时,当用户窗体中的列表框包含大量的项目时,我们必须拖动其滚动条来查找相应的项目。此时,可以利用一些技巧快速找到所需的项目。
如图1所示,在用户窗体中,放置有两个控件,上方是一个名为txtFind的文本框,下方是一个名为lbxData的列表框,列表框的数据来自工作表Data的列A中的数据。
ListBoxFilter1
图1:带有文本框和列表框的用户窗体,列表框中的数据来自Data工作表中的A列
当我在上方的文本框txtFind中输入“excel vba”后,下方的列表框lbxData中将会只出现包含有“excel vba”的条目,如图2所示。
ListBoxFilter2
图2:在文本框中输入文本后,列表框中只出现包含该文本的条目
实现上述效果的VBA代码如下:

Option Explicit
Dim varData
 
Private Sub txtFind_Change()
    Dim i As Long
    Dim strFind As String
 
    strFind = "*" & UCase(Me.txtFind.Text) & "*"
 
    With Me.lbxData
        .List = varData
        For i = .ListCount - 1 To 0 Step -1
            If Not UCase(.List(i)) Like strFind Then
                .RemoveItem i
            End If
        Next i
    End With
End Sub
 
Private Sub UserForm_Initialize()
    Dim lLast As Long
    Dim rng As Range
 
    lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).Row
    varData = Sheet1.Range("A1:A" & lLast)
 
    Me.lbxData.List = varData
End Sub

我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除,这样当在文本框txtFind中输入时,只要输入的数据符合列表框包含的数据,列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据,如图3、4、5所示。
ListBoxFilter3
图3:初始化后的用户窗体
ListBoxFilter4
图4:开始输入后,列表框中的条目随着文本框中输入的数据而变化
ListBoxFilter5
图5:文本框中的数据越具体,列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中,VBA提供了一个Filter函数,使用该函数,也能实现上述效果,并且代码更简单。代码如下:

Option Explicit
Private Sub txtFind_Change()
    Dim varData As Variant
 
    varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
    varData = Application.Transpose(varData)
 
    varData = Filter(SourceArray:=varData, _
                   Match:=txtFind.Value, _
                   Include:=True, _
                   Compare:=vbTextCompare)
 
    Me.lbxData.List = varData
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
End Sub

如果需要将列表框中所选择的条目放到文本框中,那么添加下面的代码:

Private Sub lbxData_Click()
    Me.txtFind.Value = Me.lbxData.Value
End Sub

示例文档下载:
在使用Google搜索时,一般我们会在输入框中输入想要搜索的文本,此时下方会出现相关条目供选择,以方便快速输入。下面,我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时,当用户窗体中的列表框包含大量的项目时,我们必须拖动其滚动条来查找相应的项目。此时,可以利用一些技巧快速找到所需的项目。
如图1所示,在用户窗体中,放置有两个控件,上方是一个名为txtFind的文本框,下方是一个名为lbxData的列表框,列表框的数据来自工作表Data的列A中的数据。
ListBoxFilter1
图1:带有文本框和列表框的用户窗体,列表框中的数据来自Data工作表中的A列
当我在上方的文本框txtFind中输入“excel vba”后,下方的列表框lbxData中将会只出现包含有“excel vba”的条目,如图2所示。
ListBoxFilter2
图2:在文本框中输入文本后,列表框中只出现包含该文本的条目
实现上述效果的VBA代码如下:

Option Explicit
Dim varData
 
Private Sub txtFind_Change()
    Dim i As Long
    Dim strFind As String
 
    strFind = "*" & UCase(Me.txtFind.Text) & "*"
 
    With Me.lbxData
        .List = varData
        For i = .ListCount - 1 To 0 Step -1
            If Not UCase(.List(i)) Like strFind Then
                .RemoveItem i
            End If
        Next i
    End With
End Sub
 
Private Sub UserForm_Initialize()
    Dim lLast As Long
    Dim rng As Range
 
    lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).Row
    varData = Sheet1.Range("A1:A" & lLast)
 
    Me.lbxData.List = varData
End Sub

我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除,这样当在文本框txtFind中输入时,只要输入的数据符合列表框包含的数据,列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据,如图3、4、5所示。
ListBoxFilter3
图3:初始化后的用户窗体
ListBoxFilter4
图4:开始输入后,列表框中的条目随着文本框中输入的数据而变化
ListBoxFilter5
图5:文本框中的数据越具体,列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中,VBA提供了一个Filter函数,使用该函数,也能实现上述效果,并且代码更简单。代码如下:

Option Explicit
Private Sub txtFind_Change()
    Dim varData As Variant
 
    varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
    varData = Application.Transpose(varData)
 
    varData = Filter(SourceArray:=varData, _
                   Match:=txtFind.Value, _
                   Include:=True, _
                   Compare:=vbTextCompare)
 
    Me.lbxData.List = varData
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
End Sub

如果需要将列表框中所选择的条目放到文本框中,那么添加下面的代码:

Private Sub lbxData_Click()
    Me.txtFind.Value = Me.lbxData.Value
End Sub

示例文档下载:

相关文章

复制用户窗体文本框里的数据

1 颗星2 颗星3 颗星4 颗星5 颗星 (3 人投票, 平均: 3.67 out of 5)
Loading ... Loading ...

通常,我们可以在选择要复制的文本后,按Ctrl+C组合键来复制文本。下面通过两个简单的示例介绍如何使用VBA代码复制用户窗体文本框中的文本数据。
示例一:如下图1所示,在示例窗体中有一个文本框和一个命令按钮。当窗体被激活时,文本框中自动显示文字“完美Excel”,单击“复制文本”按钮后,将文本框中的数据复制到剪贴板。
copytextfromtextbox1
图1:带有文本框和命令按钮的用户窗体
首先,按图1设计好用户窗体界面。然后,在该用户窗体模块中,输入下列代码:

Dim myClipboard As New DataObject
 
Private Sub UserForm_Activate()
    Me.TextBox1.Value = "完美Excel"
End Sub
 
Private Sub CommandButton1_Click()
    With myClipboard
        .SetText Me.TextBox1.Text
        .PutInClipboard
    End With
End Sub

示例二:在用户窗体中有多个文本框,要求单击按钮后将含有数据的文本框中的数据全部复制到剪贴板。用户窗体如下图2所示,含有6个文本框。
copytextfromtextbox2
图2:带有多个文本框的用户窗体
首先,按图2设计好用户窗体界面。然后,在用户窗体模块中,输入下列代码:

Dim strUnion As String
 
Private Sub CommandButton1_Click()
    Dim dObj As DataObject
    With Me
        If Not .TextBox1 = Empty Then strUnion = strUnion & .TextBox1
        If Not .TextBox2 = Empty Then strUnion = strUnion & vbCrLf & .TextBox2
        If Not .TextBox3 = Empty Then strUnion = strUnion & vbCrLf & .TextBox3
        If Not .TextBox4 = Empty Then strUnion = strUnion & vbCrLf & .TextBox4
        If Not .TextBox5 = Empty Then strUnion = strUnion & vbCrLf & .TextBox5
        If Not .TextBox6 = Empty Then strUnion = strUnion & vbCrLf & .TextBox6
    End With
 
    Set dObj = New DataObject
 
    dObj.SetText strUnion, 1
    dObj.PutInClipboard
End Sub

说明与扩展
下面对示例中涉及到的主要对象及其属性、方法进行简单的介绍和整理,并进行一些扩展(也可参考VBA帮助)。
本文虽然题为复制文框框中的数据,但DataObject对象也可应用到其他的用户窗体控件中。

  • DataObject 对象
    DataObject对象能够像“剪贴板”一样保存一段文本格式的文本,并能为每种附加的文本格式(例如用户定义的格式)保存一段文本。
    DataObject对象的工作方式与“剪贴板”很相像。如果将一串文本复制到DataObject对象,DataObject 对象将保存该文本。如果将相同格式的第二段文本复制到该DataObject对象,则DataObject对象将清除前一文本,并保存第二段的文本。对于每种指定的格式,它保存一段从最近一次操作得到的文本。
    但DataObject对象又与“剪贴板”不同,DataObject支持与“剪贴板”及文本的拖放操作有关的命令。在开始进行与“剪贴板”有关的操作(如GetText)或拖放操作时,与该操作有关的数据会被移到DataObject对象中。
    DataObject对象具有下列方法:

    • SetText方法:使用特定的格式复制文本串到DataObject对象中。
    • GetText方法:使用特定的格式在DataObject对象中检索文本串。
    • GetFormat方法:返回的值表示DataObject对象中是否有指定的格式。
    • StartDrag方法:初始化针对DataObject的拖放操作。
    • GetFromClipboard:从剪贴板复制数据到DataObject对象。
    • PutInClipboard:将数据从DataObject对象移到剪贴板上。
    • Clear方法:删除DataObject对象中的所有对象。
  •  

  • GetFormat方法、GetText方法 和SetText方法示例
    本示例使用GetFormat方法、GetText方法和SetText方法在DataObject对象和剪贴板之间传输文本。
    示例窗体如下图3所示,带有一个文本框TextBox1,四个命令按钮CommandButton1、CommandButton2、CommandButton3和CommandButton,以及一个标签Label1。用户把文本键入文本框然后单击命令按钮CommandButton1,把文本以标准文本格式传输到DataObject对象。单击命令按钮CommandButton2,在DataObject对象中检索文本。单击命令按钮CommandButton3,用自定义格式把文本从文本框TextBox1复制到DataObject对象。单击命令按钮CommandButton4,用自定义格式在DataObject对象中检索文本。
    copytextfromtextbox3
    图3:演示GetFormat、GetText、SetText方法的用户窗体
    窗体模块中的代码为:

    Dim MyDataObject As DataObject
     
    Private Sub CommandButton1_Click()
        '把标准格式放到剪贴板上
        If TextBox1.TextLength > 0 Then
            Set MyDataObject = New DataObject
            MyDataObject.SetText TextBox1.Text
            Label1.Caption = "放置到DataObject中"
            CommandButton2.Enabled = True
            CommandButton4.Enabled = False
        End If
    End Sub
     
    Private Sub CommandButton2_Click()
        '从剪切板得到标准格式
        If MyDataObject.GetFormat(1) = True Then
            Label1.Caption = "标准格式 - " _
                & MyDataObject.GetText(1)
        End If
    End Sub
     
    Private Sub CommandButton3_Click()
        '把自定义格式放到剪切板上
        If TextBox1.TextLength > 0 Then
            Set MyDataObject = New DataObject
            MyDataObject.SetText TextBox1.Text, 233
            Label1.Caption = "在DataObject中的自定义格式"
            CommandButton4.Enabled = True
            CommandButton2.Enabled = False
        End If
    End Sub
     
    Private Sub CommandButton4_Click()
        '从剪切板得到自定义格式
        If MyDataObject.GetFormat(233) = True Then
            Label1.Caption = "自定义格式 - " _
                & MyDataObject.GetText(233)
        End If
    End Sub
     
    Private Sub UserForm_Initialize()
        CommandButton2.Enabled = False
        CommandButton4.Enabled = False
    End Sub
  •  

  • Copy方法、GetFromClipboard方法、GetText方法和DataObject对象示例
    本示例演示从文本框到剪贴板,从剪贴板到DataObject对象以及从DataObject对象到另一个文本框的数据移动。GetFromClipboard方法把数据从剪贴板传输到DataObject对象。该示例还使用了Copy方法和GetText方法。
    示例窗体如下图4所示,带有两个文本框和一个命令按钮。单击命令按钮,将把文本从一个文本框移至另一个文本框。
    copytextfromtextbox4
    图4:Copy、GetFromClipboard、GetText和DataObject对象示例窗体
    窗体模块中的代码如下:

    Dim MyData as DataObject
     
    Private Sub CommandButton1_Click()
        '在把文本复制到剪切板之前,需要选定一段文本
        TextBox1.SelStart = 0
        TextBox1.SelLength = TextBox1.TextLength
        TextBox1.Copy
     
        MyData.GetFromClipboard
        TextBox2.Text = MyData.GetText(1)
    End Sub
     
    Private Sub UserForm_Initialize()
        Set MyData = New DataObject
        TextBox1.Text = "移动数据到剪贴板,然后到DataObject,接着到另一文本框!"
    End Sub
  •  

  • 列表框控件、DataObject对象、MouseMove事件和StartDrag方法、SetText方法示例
    本示例使用DataObject对象来包含拖动文本,演示从一个列表框到另一个列表框的拖放操作。在MouseMove事件中使用SetText方法和StartDrag方法来完成拖放操作。
    示例窗体如下图5所示,带有两个列表框。
    copytextfromtextbox5
    图5:从一个列表框中拖动数据并放置到另一个列表框中
    窗体模块代码如下:

    Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
        MSForms.ReturnBoolean, ByVal Data As _
        MSForms.DataObject, ByVal X As Single, _
        ByVal Y As Single, ByVal DragState As Long, _
        ByVal Effect As MSForms.ReturnEffect, _
        ByVal Shift As Integer)
        Cancel = True
        Effect = 1
    End Sub
     
    Private Sub ListBox2_BeforeDropOrPaste(ByVal _
        Cancel As MSForms.ReturnBoolean, _
        ByVal Action As Long, ByVal Data As _
        MSForms.DataObject, ByVal X As Single, _
        ByVal Y As Single, ByVal Effect As _
        MSForms.ReturnEffect, ByVal Shift As Integer)
        Cancel = True
        Effect = 1
        ListBox2.AddItem Data.GetText
    End Sub
     
    Private Sub ListBox1_MouseMove(ByVal Button As _
         Integer, ByVal Shift As Integer, ByVal X As _
         Single, ByVal Y As Single)
        Dim MyDataObject As DataObject
        If Button = 1 Then
            Set MyDataObject = New DataObject
            Dim Effect As Integer
            MyDataObject.SetText ListBox1.Value
            Effect = MyDataObject.StartDrag
        End If
    End Sub
     
    Private Sub UserForm_Initialize()
        Dim i As Long
        For i = 1 To 10
            ListBox1.AddItem "Choice " _
                & (ListBox1.ListCount + 1)
        Next i
    End Sub
  •  

  • DataObject对象和“剪贴板”的区别
    DataObject对象和“剪贴板”都提供了将数据从一处移到另一处的方法。作为应用程序开发人员,无论是使用DataObject对象还是使用“剪贴板”,都要记住下列几项要点:

    • 只要各项数据具有不同的数据格式,DataObject对象和“剪贴板”就都可以同时保存多项数据。但是如果已经有数据使用了要保存数据的格式,则保存这个新数据,并丢弃原来的数据。
    • “剪贴板”支持图片格式和文本格式。而DataObject对象目前只支持文本格式。
    • 只有应用程序运行时,DataObject对象才存在;而“剪贴板”则是始终运行的(与正在运行的操作系统同时存在)。这意味着,将数据放到“剪贴板”后,如果关闭了应用程序,“剪贴板”上的数据不会丢失。DataObject对象则没有这个功能。如果关闭应用程序,该应用程序放置在DataObject对象上的数据就会丢失。
    • DataObject对象是一个标准的OLE对象,而“剪贴板”不是。这意味着,“剪贴板”支持标准的移动操作(复制、剪切和粘贴),但不支持拖放操作。如果需要应用程序支持拖放操作,就必须使用DataObject对象。
    • 提示 当用SetText方法将数据移动到“剪贴板”或DataObject对象时,可定义自己的数据格式名称。这样便于区分是应用程序移动的文本还是用户移动的文本。

示例文档下载:

相关文章