Question

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

由于

Answer 1

下面的代码假定您有两个重叠的命名范围。我拨打了一个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

中所有验证的单元格

Answer 2

根据@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

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

2 个答案: