# VBA处理excel工作表中的注释信息

- 连结：https://blog.guohao.asia/vba%e5%a4%84%e7%90%86excel%e5%b7%a5%e4%bd%9c%e8%a1%a8%e4%b8%ad%e7%9a%84%e6%b3%a8%e9%87%8a%e4%bf%a1%e6%81%af.html
- 发布时间：2024-06-06T09:44:57+08:00
- 作者：null

中文   英文   韩语   日语

以下代码可实现：

将当前工作表中的所有 ** 注释 ** 内容复制到新工作表的单元格中，复制后的内容在同一
列由上向下排列

    ```language-default
    Attribute VB_Name = "当前工作表内所有注释复制到新工作表"
    Sub CopyCellCommentsToNewSheet()
        Dim wsSource As Worksheet
        Dim wsTarget As Worksheet
        Dim i As Long
        Dim r As Range
        Dim lastRow As Long

        ' 设置源工作表为当前活动工作表
        Set wsSource = ActiveSheet

        ' 创建新工作表并设置为目标工作表
        Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count))
        wsTarget.Name = "Comments"

        ' 遍历源工作表中的所有单元格
        i = 1
        For Each r In wsSource.UsedRange
            If Not r.comment Is Nothing Then
                ' 如果单元格有注释，将其内容复制到新工作表的 A 列
                wsTarget.Cells(i, 1).Value = r.comment.Text
                ' 更新 i 以指向新行
                i = i + 1
            End If
        Next r

        ' 计算新工作表中最后一个非空单元格的行号
        lastRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row

        ' 可选：自动调整列宽以适应内容
        wsTarget.Columns("A").AutoFit

        ' 可选：清除新工作表中的空白单元格
        If lastRow < wsTarget.Rows.Count Then
            wsTarget.Range(wsTarget.Cells(lastRow + 1, 1), wsTarget.Cells(wsTarget.Rows.Count, 1)).ClearContents
        End If

        ' 可选：提示用户完成操作
        MsgBox "所有注释已成功复制到新工作表。", vbInformation, "完成"
    End Sub
    ```

[线程式批注和注释之间的区别 – Microsoft 支持](https://blog.guohao.asia/wp-content/themes/wordpress-theme-puock-2.8.16/inc/go.php?to=aHR0cHM6Ly9zdXBwb3J0Lm1pY3Jvc29mdC5jb20vemgtY24vb2ZmaWNlL+e6v+eoi+W8j+aJueazqOWSjOazqOmHiuS5i+mXtOeahOWMuuWIqy03NWE1MWVlYy00MDkyLTQyYWItYWJmOC03NjY5MDc3YjdiZTM=)