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

左手的ㄟ右手 2023-02-17 03:27 32阅读 0赞

# 批量插入批注 #

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