求助：如何实现在一个Excel文件中多个工作表的“下拉框+多选+录入指定单元格“

zjwieh

问题描述：

1、如何实现在同一个Excel文件中的多个工作表中，双击某特定单元格时，弹出多选下拉框；
2、双击或单击其他单元格时，不会弹出该多选下拉框；
3、多选下拉框的内容，可以实时更新或增加；
4、双击某特定单元格时，多选下拉框中新选中的内容，在录入该特定单元格时，原内容不会被覆盖；
5、多选下拉框中的内容被选中2及以上时，每条内容以”换行符“换行。
在此，小弟先谢过大牛！
再次感谢！

3190496160

既要在单元格中录入新的数据，原来的数据对后续工作没有意义，又不能删除原来的数据，似乎是不可能的

3190496160

Private Sub ListBox1_Change()
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        If InStr(zd, ListBox1.List(i, 0)) = 0 Then
            If zd = "" Then
                zd = ListBox1.List(i, 0)
            Else
                zd = zd & Chr(10) & ListBox1.List(i, 0)
            End If
        End If
    End If
Next i
ActiveCell = zd
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
If T.Row = 9 And T.Column = 2 Then
    Dim ar As Variant
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Sheets("数据源")
        r = .Cells(Rows.Count, 1).End(xlUp).Row
        ar = .Range("a1:e" & r)
    End With
    For i = 2 To UBound(ar)
        If Trim(ar(i, 2)) <> "" Then
            d(Trim(ar(i, 2))) = ""
        End If
    Next i
    With ListBox1
        .Visible = True
        .List = d.keys
    End With
Else
    ListBox1.Visible = False
End If
End Sub

3190496160

3190496160

只做了sheet1的代码，仅供参考
样本数据_如何实现下拉框 多选 录入指定单元格.rar (22.66 KB, 下载次数: 5)

2023-5-23 11:45 上传

点击文件名下载附件

zjwieh

3190496160 发表于 2023-5-23 11:45
只做了sheet1的代码，仅供参考

非常感谢，这段代码太厉害了
大牛可否能够实现在全部的sheet表中的特定位置，实现下拉框
如果我把代码复制到每一个sheet中，且sheet在几十张的时候，就会影响操作速度

zjwieh

3190496160 发表于 2023-5-23 11:45
只做了sheet1的代码，仅供参考

另外，这个待输入内容的单元格是否可以通过VBA语句，根源该单元格的内容进行定位（该单元格的位置，不固定）

3190496160

zjwieh 发表于 2023-5-23 14:03
另外，这个待输入内容的单元格是否可以通过VBA语句，根源该单元格的内容进行定位（该单元格的位置，不固 ...

不明白你说的是什么意思？？

3190496160

zjwieh 发表于 2023-5-23 13:54
非常感谢，这段代码太厉害了
大牛可否能够实现在全部的sheet表中的特定位置，实现下拉框
如果我把代码 ...

如果所有工作表内的位置是一致的，好办，但是，如果位置不一致的话，就麻烦

zjwieh

3190496160 发表于 2023-5-23 14:12
不明白你说的是什么意思？？

大牛，不好意思，恕我表达能力不足。
我的意思如下：
1、比如sheet1中，通过判断“原单元格”的内容“是否为请输入公司名称“，来确定下拉框出现的位置；
2、比如sheet2中，通过判断“原单元格”的内容“是否为请录入项目名称“，来确定下拉框出现的位置；
3、在其他sheet表，判断下拉框的位置，如同1、2描述。
多谢！