gpt4 book ai didi

excel - 下拉列表中的多项选择,但排除一个单元格

转载 作者:行者123 更新时间:2023-12-04 20:25:20 25 4
gpt4 key购买 nike

我正在使用 VBA 代码(我在网上找到的,我不太擅长 VBA)从下拉列表中选择多个项目。但是,我希望我的工作簿中的一个单元格(单元格 $D$3)不受此宏的影响。因此,虽然它具有数据验证功能,但您只能选择一个选项。任何帮助表示赞赏,我正在努力学习!

这是我使用的代码

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, ", " & xValue2) Or _
InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & ", " & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub

最佳答案

BigBen评论了一个解决我问题的答案,谢谢!

这是对我有用的修订版:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Me.Range("D3")) Is Nothing Then Exit Sub
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, ", " & xValue2) Or _
InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1

关于excel - 下拉列表中的多项选择,但排除一个单元格,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/61661304/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com