Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 415|回复: 4

[已解决] 求助自动添加单元格批注的VBA代码

[复制链接]
发表于 2020-1-16 09:26 | 显示全部楼层 |阅读模式
求助高手达人,帮忙写自动添加单元格批注的VBA代码(以下两个方案,各写出一个最好,不然写出一个也感激不尽)。

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

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



数据源请参附件。
谢谢!

看板 (VBA自动添加批注).rar

59.34 KB, 下载次数: 1

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2020-1-16 11:50 | 显示全部楼层
本帖最后由 爱疯 于 2020-1-16 14:35 编辑

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, 下载次数: 47)
回复

使用道具 举报

 楼主| 发表于 2020-1-16 13:37 | 显示全部楼层
万分感谢爱疯版主,正是我想要的。
回复

使用道具 举报

 楼主| 发表于 2020-1-20 16:08 | 显示全部楼层
爱疯 发表于 2020-1-16 11:50
Private Sub Worksheet_SelectionChange(ByVal Target As Range)



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

Error91-2.jpg
Error91.jpg
回复

使用道具 举报

发表于 2020-1-20 16:33 | 显示全部楼层
能上传下附件吗?
具体是在做什么时出现的?
回复

使用道具 举报

*滑块验证:
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2020-8-14 04:27 , Processed in 0.062400 second(s), 6 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表