如何使用可编辑的动态下拉列表

Question

我现在正在研究VBA代码，该代码应：

• 让您从下拉列表中选择文本
• 选择多个文本并将其放在下一行
• 让您编辑单元格的值。 这里的问题是，当我禁用错误消息时-我可以编辑单元格，将目标单元格中​​的值添加到该单元格中。

因此，例如，我想在下拉单元格中将B修改为C。 相反，我得到了ABAC

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String

On Error GoTo Errorhandling

If Not Application.Intersect(Target, Range("A6")) Is Nothing Then


  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling

  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & vbCrLf & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

Errorhandling:
Application.EnableEvents = True
End Sub

Answer 1

1. 您必须使用vbLf作为单元格中的换行符，而不是vbCrLf
2. 使用Option Explicit可以防止使用错误的变量名。 您声明了wert_old但使用了wertold 。 这很容易搞砸，让您发疯。 我建议始终激活Option Explicit ：在VBA编辑器中，转到“ 工具” ›“ 选项” ›“ 需要变量声明” 。

3. 解决方法是，只有在不包含vbLf ，才可以运行代码来运行
   InStr(1, Target.Value, vbLf) < 1

   请注意，如果其中有多个项目，则此解决方法将使您能够编辑该单元格，但是如果您尝试编辑它仅包含一个项目，它仍将添加它（我对此没有解决方法）。

因此，您最终得到如下结果：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Errorhandling

    If Not Application.Intersect(Target, Me.Range("A6")) Is Nothing Then
        Dim rngDV As Range
        Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
        If rngDV Is Nothing Then GoTo Errorhandling

        If Not Application.Intersect(Target, rngDV) Is Nothing And InStr(1, Target.Value, vbLf) < 1 Then
            Application.EnableEvents = False

            Dim WertNew As String
            WertNew = Target.Value

            Application.Undo

            Dim WertOld As String
            WertOld = Target.Value
            Target.Value = WertNew
            If WertOld <> vbNullString Then
                If WertNew <> vbNullString Then
                    Target.Value = WertOld & vbLf & WertNew
                End If
            End If
        End If
        Application.EnableEvents = True
    End If

Errorhandling:
    Application.EnableEvents = True
End Sub