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