求助自动添加单元格批注的VBA代码

流水无言

求助高手达人，帮忙写自动添加单元格批注的VBA代码（以下两个方案，各写出一个最好，不然写出一个也感激不尽）。

方案1：当选中区域G3;AQ6,D10:K80,M10:BA46中任意单元格时，根据单元格内容在工作表【Details】中查找（索引列为K列，结果在AA列），将查找到的结果添加为选中单元格的批注内容。如果未查找到则不添加批注。
批注要能根据内容大小自动调整合适的宽度和高度。
VBA触发条件：选中目标区域任意单元格时。

方案2：目标区域G3;AQ6,D10:K80,M10:BA46内所有的单元格，根据单元格内容在工作表【Details】中查找（索引列为K列，结果在AA列），将查找到的结果批量添加为单元格的批注内容，未查找到的单元格不添加批注。
批注要能根据内容大小自动调整合适的宽度和高度。
VBA触发条件：目标区域内容有变更或工作表【Details】内容有变更时。



数据源请参附件。
谢谢！

爱疯

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    '当选中区域G3:AQ6,D10:K80,M10:BA46中任意单元格时
    If Not Application.Intersect(Range("G3:AQ6,D10:K80,M10:BA46"), Target) Is Nothing Then
   
        '加批注
        Call addcmt(Target(1))
   
    End If
   
End Sub













'工作表【Details】内容有变更时
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Range, y As Range

    '批注有变的新编码
    Set x = Cells(Target.Row, "k")

    '在看板里的位置
    Set y = Sheets(1).Cells.Find(x)

    '更新
    If Not y Is Nothing Then Call addcmt(y)

End Sub










'加批注
Sub addcmt(x As Range)
    Dim sh As Worksheet
    Dim y As Range


    If Len(x) Then
        Set sh = Sheets(2)
        
        '根据单元格内容在工作表【Details】中查找（索引列为K列
        Set y = sh.Range("k:k").Find(x)
        
        If Not y Is Nothing Then
            With x
            
                '结果在AA列），将查找到的结果批量添加为单元格的批注内容
                .NoteText sh.Cells(y.Row, "aa")
                .Comment.Shape.TextFrame.AutoSize = True
                .Comment.Shape.TextFrame.Characters.Font.Size = 14
            End With
        End If
    End If
End Sub





依次是 看板 的、Details的、模块的 代码
看板 (VBA自动添加批注)2.rar (77 KB, 下载次数: 52)

2020-1-16 11:47 上传

点击文件名下载附件

流水无言

万分感谢爱疯版主，正是我想要的。

流水无言

爱疯 发表于 2020-1-16 11:50
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

我修改单元格内容后，选择部分单元格时报错。报错见附件截图。
我用的Excel2016，别人用Excel2019操作却不报错。不解。

爱疯

能上传下附件吗？
具体是在做什么时出现的？