1 使用VBA实现EXCEL多选下拉框

1.1 简介

在开发系统功能中，我们经常用到EXCEL作为模版，来实现某些业务的导入功能。某些业务中，我们会遇到多选值的情况，按照EXCEL默认的数据有效性功能，没有办法实现多选的业务。下面介绍使用VBA实现EXCEL多选下拉框：

1.2 实现多选下拉框步骤

Excel的数据有效性可以实现单选下拉框，但是无法完成多选的功能。所以在这里就需要借助VBA来实现多选的功能。

下面是最终的效果图：

第一步、新建一个空白的EXCEL文件，找到“开发工具”菜单，在菜单下找到插入，选择“列表框控件”

选择控件之后，在EXCEL文件里面随便找一个地方，将该控件画出来

控件名称

第二步、找到sheet1，右键-查看代码，打开VBA编辑器。

第三步、双击ThisWorkbook，在打开的编辑界面输入代码。

Private Sub Workbook_Open()

       Sheet1.ListBox1.Visible = True

End Sub

该行代码功能主要是将控件默认隐藏

第四步、双击Sheet1，在打开的编辑界面输入以下代码。

Private Sub ListBox1_Change()

ActiveCell.Value = ""

Dim k&, j&

With Sheet1.ListBox1

    For i = 0 To Sheet1.ListBox1.ListCount - 1

        If Sheet1.ListBox1.Selected(i) = True Then

             k = k + 1

        End If

    Next i

End With

With Sheet1.ListBox1

    For i = 0 To Sheet1.ListBox1.ListCount - 1

        If Sheet1.ListBox1.Selected(i) = True Then

            j = j + 1

            If k > j Then

                 ActiveCell.Value = ActiveCell.Value + Sheet1.ListBox1.List(i) + ","

            End If

            If k = j Then

                ActiveCell.Value = ActiveCell.Value + Sheet1.ListBox1.List(i)

            End If

        End If

    Next i

End With

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 17 And Target.Row > 1 Then

Sheet1.ListBox1.Visible = True

 With Sheet1.ListBox1

                       .Visible = True

                       .Width = Target.Width

                       .Height = 60

                       .Left = Target.Left

                       .Top = Target.Top + Target.Height

                       .MultiSelect = fmMultiSelectMulti

                       .ListStyle = fmListStyleOption

                       .Clear

               End With

  ListBox1.AddItem "大气污染防治", 0

  ListBox1.AddItem "土壤污染防治", 1

  ListBox1.AddItem "水污染防治", 2

  ListBox1.AddItem "中央农村节能减排", 3

  ListBox1.AddItem "生态保护修复治理", 4

  ListBox1.AddItem "其他专项", 5

 End If

 If Target.Column <> 17 Or Target.Row = 1 Then

  Sheet1.ListBox1.Visible = Fale

 End If

End Sub

代码解析：

Private Sub ListBox1_Change()//监听控件值变化事件

ActiveCell.Value = ""

Dim k&, j&

//获取所有选择的数量

With Sheet1.ListBox1

    For i = 0 To Sheet1.ListBox1.ListCount - 1

        If Sheet1.ListBox1.Selected(i) = True Then

             k = k + 1

        End If

    Next i

End With

//获取选中的值，并给当前选中的单元格赋值

With Sheet1.ListBox1

    For i = 0 To Sheet1.ListBox1.ListCount - 1

        If Sheet1.ListBox1.Selected(i) = True Then

            j = j + 1

            If k > j Then

                 ActiveCell.Value = ActiveCell.Value + Sheet1.ListBox1.List(i) + ","            End If

            If k = j Then

                ActiveCell.Value = ActiveCell.Value + Sheet1.ListBox1.List(i)

            End If

        End If

    Next i

End With

End Sub

//初始化控件

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

//只有当前单元格选择的是第17列，并且不是第一行的时候才初始化数据

If Target.Column = 17 And Target.Row > 1 Then

Sheet1.ListBox1.Visible = True

 With Sheet1.ListBox1

                       .Visible = True//显示控件

                       .Width = Target.Width//控件的宽度

                       .Height = 60//控件的高度

                       .Left = Target.Left//控件距离左侧的位置

                       .Top = Target.Top + Target.Height//控件距离顶部的位置

                       .MultiSelect = fmMultiSelectMulti//设置控件为多选下拉框(重要)

                       .ListStyle = fmListStyleOption//设置控件的显示风格为checkbox(重要)

                       .Clear//清空所有数据

               End With

  ListBox1.AddItem "大气污染防治", 0//初始化控件的值

  ListBox1.AddItem "土壤污染防治", 1

  ListBox1.AddItem "水污染防治", 2

  ListBox1.AddItem "中央农村节能减排", 3

  ListBox1.AddItem "生态保护修复治理", 4

  ListBox1.AddItem "其他专项", 5

 End If

//设置当点击的单元格不是第17列或者是第一行的时候，隐藏掉控件

 If Target.Column <> 17 Or Target.Row = 1 Then

  Sheet1.ListBox1.Visible = Fale

 End If

End Sub

自此我们代码部分就已经写完了，按F5新建一个modules运行、调试即可。当然，因为该功能是使用VBA开发的，需要用到EXCEL的宏功能，所以在使用的过程中，需要允许启用宏功能才能使用。WPS若没有“开发工具”这一菜单选项，需要自己去下载相应的增强插件。如：vba提取自WPS2012专业增强版

以上代码为同事分享，以防以后用上，打个标签。

请您注意

·自觉遵守：爱国、守法、自律、真实、文明的原则
·尊重网上道德，遵守《全国人大常委会关于维护互联网安全的决定》及中华人民共和国其他各项有关法律法规
·严禁发表危害国家安全，破坏民族团结、国家宗教政策和社会稳定，含侮辱、诽谤、教唆、淫秽等内容的作品
·承担一切因您的行为而直接或间接导致的民事或刑事法律责任
·您在NoteShare上发表的作品，NoteShare有权在网站内保留、转载、引用或者删除
·参与本评论即表明您已经阅读并接受上述条款