如何使用验证列表向列添加动态注释？

Question

给出带有验证列表的excel列（下拉列表）。如何根据所选选项显示动态评论？

谢谢

Answer 1

根据@Variatus的回答，此代码适用于较长的游侠。不仅是一个细胞

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DropVal As Variant
    Dim Commt As String


 Set KeyCells = Range("E1:E1000")

    With Target


        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
            DropVal = .Value
            If Len(Trim(DropVal)) Then
                Commt = Application.VLookup(DropVal, Range("Comments"), 2, False)
                With Range(Target.Address)
                    .ClearComments
                    .AddComment Commt
                End With
            End If
        End If
    End With
End Sub

Answer 2

下面的代码假定您有两个重叠的命名范围。我叫了一个DropList，另一个叫Comments。 Comments范围包括两列，第一列被声明为DropList。例如，

DropList = M2:M10 (any sheet)
Commments = M2:N10

DropList拥有数据验证中的所有项目。输入=DropList代替实际的项目列表。这是为了确保下拉列表中的列表与代码查找注释所需的内容保证一致。在Comments范围的第二列中写下与每个下拉项关联的注释。列表的最佳位置是您隐藏的专用工作表。避免将其放在另一个工作表的不可见部分，因为这会降低工作簿的速度。

将下面的代码放在您的下拉列表的工作表的代码表中。请注意，您可以为下拉列表和要评论的单元格设置任何地址。

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 03 Jan 2018

    Const DropColumn As String = "J"          ' location of drop-down
    Const CommentColumn As String = "K"       ' location of comment

    Dim DropVal As Variant
    Dim Commt As String
    Dim Test As Long

    With Target
        If .Column = Columns(DropColumn).Column Then
            On Error Resume Next
            Test = .Validation.Type
            If Err Then
                Err.Clear
            Else
                DropVal = .Value
                If Len(Trim(DropVal)) Then
                    Commt = Application.VLookup(DropVal, Range("Comments"), 2, False)
                    With Cells(.Row, Columns(CommentColumn).Column)
                        .ClearComments
                        .AddComment Commt
                    End With
                End If
            End If
        End If
    End With
End Sub

修改了上述代码，以便在DropColumn中对所有单元格进行验证