WPS office excel设置单元格下拉选择可多选

简述

excel设置单元格下拉选择可多选，文末有附件下载

前情提示

系统：Windows、Mac

微软office2021、office365、Excel

一说

• 部分截图、链接等因过期、更换域名、MD语法等可能不显示，可联系反馈（备注好博文地址），谢谢❤
• 带有#号、删除线、不操作、不执行字样的为提示或者备份bash，实际不执行
• 如果无法下载、无法复制，请评论后留言即可。收到消息后会第一时间回复～
• 知识付费，1对1技术支持：https://www.yuque.com/janeyork/blog/qorzdcrp4gbxy82w?singleDoc#

有账号的朋友，可以点个赞或者评论两句哦，评论后会获得积分奖励～

演示视频|问题视频 https://www.ixigua.com/7303799599003599414

方式一

设置自动列宽，略

需要保存为xlsm格式

涉及到VBA宏，或者直接新建xlsm文件

设置数据验证（这一步是单选的下拉框）

选择某列，或者某个单元格 - 数据 - 数据验证 - 设置 - 序列 - 英文逗号分割

取消勾选出错警告（可选）

不设置提示，或者自定义提示，都在这里设置

设置BVA宏代码

• 此代码初版可用，但是仍不完善，如果正常使用，不影响。
• 其他BUG待你们来发现！

右键下面的sheet - 查看代码

填写以下代码，Ctrl + S保存，如果是xls文件，保存会提示启用宏无法保存，可以另存xlsm文件即可。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
If Target.Column = 8 Or Target.Column = 5 Or Target.Column = 6 Then
If oldVal = "" Then
Else
If newVal = "" Then
Else
If InStr(oldVal, newVal) > 0 Then
Target.Value = oldVal
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

If Target.Column = 8 Or Target.Column = 5 Or Target.Column = 6 Then

将这些数字换成你的多选列即可，如果只有一列 If Target.Column = 8 Then

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim arrVals() As String
    Dim i As Integer
    
    If Target.Count > 1 Then GoTo exitHandler
    
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    
    If rngDV Is Nothing Then GoTo exitHandler
    
    If Not Intersect(Target, rngDV) Is Nothing Then
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        ' MsgBox "123"
        
        If Target.Column = 8 Or Target.Column = 5 Or Target.Column = 6 Then
            ' 缺少下面的 End If
            If oldVal = "" Then
            Else
                If newVal = "" Then
                Else
                    arrVals = Split(oldVal, ",")
                    ' stringloBeFound 应该为 stringToBeFound
                    If Not IsInArray(newVal, arrVals) Then
                        ' MsgBox "not in!"
                        Target.Value = oldVal & "," & newVal
                        Target.Value = Replace(Target.Value, ",,", ",")
                    Else
                        ' MsgBox "Hello World!"
                    End If
                End If
            End If
        End If
    End If
    
exitHandler:
    Application.EnableEvents = True
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

加入错误回滚，目前用的这个

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim arrVals() As String
    Dim i As Integer
    
    If Target.Count > 1 Then GoTo exitHandler
    
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    
    If rngDV Is Nothing Then GoTo exitHandler
    
    If Not Intersect(Target, rngDV) Is Nothing Then
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        
        If Target.Column = 8 Or Target.Column = 5 Or Target.Column = 6 Then
            If oldVal = "" Then
            Else
                If newVal = "" Then
                Else
                    arrVals = Split(oldVal, ",")
                    If Not IsInArray(newVal, arrVals) Then
                        ' 保存原始值以便在错误时恢复
                        Dim originalValue As Variant
                        originalValue = Target.Value
                        Target.Value = oldVal & "," & newVal
                        Target.Value = Replace(Target.Value, ",,", ",")
                        ' On Error GoTo restoreOriginalValue
                        ' Exit Sub
                    Else
                        ' MsgBox "Hello World!"
                    End If
                End If
            End If
        End If
    End If
    
exitHandler:
    Application.EnableEvents = True
    Exit Sub

restoreOriginalValue:
    ' 发生错误时恢复原始值
    Target.Value = originalValue
    Resume exitHandler
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

WPS需要企业身份付费开通VBA宏

方式二：略

常见问题

1. 双击单元格，再失去焦点，内容重复

可能原因：开启了数据验证，且关闭了错误停止，默认遇到错误会停止，弹出提示。

2. 修改了宏，没生效，看不到效果

原因：可能是禁用了宏

或者PJ软件问题，直接强退，重开

代码中读取

easyExcel不支持宏，但是不影响读取包含宏的Excel,xlsm文件

public static void main(String[] args) {
        String fileName = "/Users/janeyork/Downloads/工作簿1.xlsm";
        EasyExcel.read(fileName, new PageReadListener<>(dataList -> {
            log.info("读取到一条数据{}", JSON.toJSONString(dataList));
        })).sheet().doRead();
    }

读取到一条数据[{3:"11",7:"中陈",8:"中"},{3:"12",7:"中陈"},{3:"13",7:"3,中陈,宽陈",8:"中, 问"},{3:"14",7:"3",8:"问"},{3:"15",6:"2",7:"3"},{3:"16",7:"2"},{3:"17"},{3:"18",7:"4"},{3:"19"},{3:"20"},{3:"21"},{3:"22"},{3:"23"},{3:"24"},{3:"25"},{3:"26"},{3:"27"},{3:"28"},{3:"29"},{3:"30"},{3:"31"},{3:"32"},{3:"33"},{3:"34"},{3:"35"},{3:"36"}]

附件

演示Excel下载：https://url37.ctfile.com/f/8850437-977377936-4a5a3b?p=4760 (访问密码: 4760)

Mac office2021免激活版下载：Microsoft Office 2021 LTSC: https://url37.ctfile.com/d/8850437-58834447-c65d2b?p=4760 (访问密码: 4760)