VBA 清除下拉列表中的内容
VBA Clear Contents in Drop Down List
我创建了一个下拉列表,每次您 select 下拉列表中的新内容都会添加到单元格中已有的内容中。问题是,我正在尝试找到一种方法来清除它,但我认为我的顺序有误。这是代码:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Worksheets("Contact Log").Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI")
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 oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If newVal = "CLEAR" Then
Selection.ClearContents
ElseIf Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
我遇到的问题是,有时,如果我 select 从下拉菜单中清除,它会将其添加到列表中,而不是清除单元格的内容。发生这种情况时,select再次清除将成功清除单元格内容。
希望这是有道理的,如果你需要我,我会澄清。出现此问题是因为我的 If 语句的顺序错误吗?
感谢您抽出宝贵时间!祝你有美好的一天!
在单元格中复制之前清除内容:
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
If newVal = "CLEAR" Then
Selection.ClearContents
GoTo exitHandler
end if
.....
第一次输入 "CLEAR" 时,lUsed
是 0 因为你没有那个字符串在 old 值所以你没有通过If lUsed > 0 Then
检查,因此未达到 If newVal = "CLEAR" Then
检查
所以你必须把``If newVal = "CLEAR"check before the
If lUsed > 0 Then` one
正如您对代码的这个小小的重构:
Option Explicit
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 Exit Sub
Set rngDV = Intersect(UsedRange, Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI"))
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo exitHandler
newVal = Target.Value
Select Case UCase(newVal)
Case "CLEAR"
Target.ClearContents
Case vbNullString
'do nothing
Case Else
Application.Undo
oldVal = Target.Value
If oldVal <> "" Then
If InStr(1, oldVal, newVal) > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End Select
exitHandler:
Application.EnableEvents = True
End Sub
仍然存在一个弱点,即在 On Error GoTo exitHandler
语句之后可能出现的每个错误都会导致您结束该子程序。
虽然您可能想处理 Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
当输入选择作为第二个值时他选择的与第一个值相同的错误
我创建了一个下拉列表,每次您 select 下拉列表中的新内容都会添加到单元格中已有的内容中。问题是,我正在尝试找到一种方法来清除它,但我认为我的顺序有误。这是代码:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Worksheets("Contact Log").Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI")
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 oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If newVal = "CLEAR" Then
Selection.ClearContents
ElseIf Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
我遇到的问题是,有时,如果我 select 从下拉菜单中清除,它会将其添加到列表中,而不是清除单元格的内容。发生这种情况时,select再次清除将成功清除单元格内容。
希望这是有道理的,如果你需要我,我会澄清。出现此问题是因为我的 If 语句的顺序错误吗?
感谢您抽出宝贵时间!祝你有美好的一天!
在单元格中复制之前清除内容:
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
If newVal = "CLEAR" Then
Selection.ClearContents
GoTo exitHandler
end if
.....
第一次输入 "CLEAR" 时,lUsed
是 0 因为你没有那个字符串在 old 值所以你没有通过If lUsed > 0 Then
检查,因此未达到 If newVal = "CLEAR" Then
检查
所以你必须把``If newVal = "CLEAR"check before the
If lUsed > 0 Then` one
正如您对代码的这个小小的重构:
Option Explicit
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 Exit Sub
Set rngDV = Intersect(UsedRange, Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI"))
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo exitHandler
newVal = Target.Value
Select Case UCase(newVal)
Case "CLEAR"
Target.ClearContents
Case vbNullString
'do nothing
Case Else
Application.Undo
oldVal = Target.Value
If oldVal <> "" Then
If InStr(1, oldVal, newVal) > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End Select
exitHandler:
Application.EnableEvents = True
End Sub
仍然存在一个弱点,即在 On Error GoTo exitHandler
语句之后可能出现的每个错误都会导致您结束该子程序。
虽然您可能想处理 Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
当输入选择作为第二个值时他选择的与第一个值相同的错误