Question

我在excel电子表格中有几个列表，我想添加多选选项。由于contexture：

，我很清楚如何做到这一点

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 = 3 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
'      NOTE: you can use a line break,
'      instead of a comma
'      Target.Value = oldVal _
'        & Chr(10) & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

问题是我只希望特定列表是多选的，我在这个excel电子表格中有几个其他列表必须保留为一个选项列表。此代码有效，但它会影响excel中的每个列表。我尝试通过添加如下所示的if语句来修改它以仅处理某些单元格

 If Target.Address = "$C$5" Or Target.Address = "$C$6" Or Target.Address = "$C$82" Then

这仍然不适合我，我该如何使这个代码单元特定？

Answer 1

对于其他任何偶然发现这个问题的人，希望找到一个如何制作特定列表的答案的多选项，我能够自己解决这个问题。

 Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo ExitHandler

lType = Target.Validation.Type
If lType = 3 Then
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    If Target.Value = "Select all that apply" Then
    oldVal = ""
    Else
    If Target.Value = newVal Then
        newVal = "Select all that apply"
    Else
        oldVal = Target.Value
    End If
    End If
    'oldVal = Target.Value
    Target.Value = newVal
    'This is where specific cells will be referenced
        If Target.Address = "$F$8" Or Target.Address = "$G$6" Or Target.Address = "$H$3" Or Target.Address = "$CJ$29" Then
            If oldVal = "" Then
            Else
                If newVal = "" Then
                Else
                    On Error Resume Next
                    Ar = Split(oldVal, ", ")
                    strVal = ""
                    For i = LBound(Ar) To UBound(Ar)
                        Debug.Print strVal
                        Debug.Print CStr(Ar(i))
                        If newVal = CStr(Ar(i)) Then
                            strVal = strVal
                            lCount = 1
                        Else
                            strVal = strVal & CStr(Ar(i)) & ", "
                        End If
                    Next i
                    If lCount > 0 Then
                        Target.Value = Left(strVal, Len(strVal) - 2)
                    Else
                        Target.Value = strVal & newVal
                    End If
                End If
            End If
        End If
    End If

要使用此特定解决方案，您还需要添加

ExitHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

到代码的最后。

多选列表excel vba

1 个答案: