Excel 用 vba 批量插入/提取批注

批量插入批注

Sub 批量插入批注()
On Error Resume Next

    '批注来源列名
    Dim targetColumnName As String
    '批注来源列号
    Dim offsetColumn As Integer
    '计数
    Dim count As Integer
    
    targetColumnName = InputBox("直接输入列名字母： ", "批注来源列")
    If targetColumnName = "" Then
        GoTo gotoEnd
    End If
    
    '算出目标列号
    offsetColumn = Range("A1:" & targetColumnName & "1").Cells.count
    
    '遍历所选列，从目标列对应行中取值插入为批注
    For Each sel In Selection
        With sel
            If Not Cells(sel.Row, offsetColumn) = "" Then
                .ClearComments
                .AddComment
                .Comment.Text Text:=Cells(sel.Row, offsetColumn).Value
                .Comment.Visible = False
                count = count + 1
            End If
        End With
    Next
    
    MsgBox "批量插入批注 " & count & "个", vbOKOnly, "批量批注完成"
    
gotoEnd:

End Sub

批量提取批注

Sub 批量提取批注()
On Error Resume Next

    '批注存放列名
    Dim targetColumnName As String
    '向左偏移几列取值
    Dim offsetColumn As Integer
    '计数
    Dim count As Integer
    
    targetColumnName = InputBox("直接输入列名字母： ", "批注内容接受列")
    If targetColumnName = "" Then
        GoTo gotoEnd
    End If
    
    '算出目标列号
    offsetColumn = Range("A1:" & targetColumnName & "1").Cells.count
    
    
    '遍历所选列，从目标列对应行中取值插入为批注
    For Each sel In Selection
        With sel
            If Not .Comment.Text = "" Then
                Cells(sel.Row, offsetColumn).Value = .Comment.Text
                .ClearComments
                count = count + 1
            End If
        End With
    Next
    
    MsgBox "批量提取批注 " & count & "个", vbOKOnly, "批量提取完成"
    
gotoEnd:

End Sub