Excel-VBA宏将单元格内容转换为另一个单元格的注释

时间:2018-08-16 11:18:26

标签: vba excel-vba comments

我有一个看似简单的目标,即将B列的内容转换为A列的注释。

table before the macro

table after the macro

我尝试使用@ Dy.Lee中提到的以下代码here,但不幸的是,它给了我运行时错误'1004'应用程序定义或对象定义的错误...

Sub Komentari()
Dim rngDB As Range, rngComent As Range
Dim rng As Range
Dim cm As Comment, i As Integer
Set rngComent = Range("A1:A50")
Set rngDB = Range("B1:B50")

For Each rng In rngComent
    i = i + 1
    If Not rng.Comment Is Nothing Then
        rng.Comment.Delete
    End If
    Set cm = rng.AddComment
    With cm
        .Visible = False
        .Text Text:=rngDB(i).value
    End With
Next rng
End Sub

请问有人可以发现错误或为此提出更好的解决方案吗?

3 个答案:

答案 0 :(得分:1)

我会这样(注释中的解释):

Public Sub Komentari()
    Dim rng As Range

    With Range("A1:A50") ' reference comments range
        .ClearComments ' clear its comments
        For Each rng In .Offset(, 1).SpecialCells(xlCellTypeConstants) ' loop through refrenced range adjacent not empty cells
            With rng.Offset(, -1).AddComment ' add comment to current rng corresponding comment range cell
                .Visible = False
                .Text rng.Value2
            End With
        Next
    End With
End Sub

答案 1 :(得分:0)

Sub Komentari()
Dim rngDB As Range, rngComent As Range
Dim rng As Range
Dim cm As Comment, i As Integer
Set rngComent = Range("A1:A50")

For Each rng In rngComent
    i = i + 1
    If Not rng.Range("B1").Comment Is Nothing Then
        rng.Range("B1").Comment.Delete
    End If
    rng.Range("B1").AddComment (rng.Text)
Next rng
End Sub

答案 2 :(得分:0)

类似于以下内容,您可以使用Offset来获取相邻范围,在将文本值添加到注释时将=删除,测试实际上是否也首先存在一个值,并确保您说明工作表,以避免隐式Activesheet引用。

Option Explicit
Public Sub Komentari()
    Dim rngComent As Range
    Dim rng As Range, cm As Comment

    With ThisWorkbook.Worksheets("Sheet1")
        Set rngComent = .Range("A1:A50")
        For Each rng In rngComent
            If Not rng.Comment Is Nothing Then
                rng.Comment.Delete
            End If
            Set cm = rng.AddComment
            With cm
                .Visible = False
                If rng.Offset(, 1) <> vbNullString Then .Text rng.Offset(0, 1).Value
            End With
        Next
    End With
End Sub

除了添加空白注释之外,您还可以将这一回合转到:

Option Explicit
Public Sub Komentari()
    Dim rngComent As Range
    Dim rng As Range, cm As Comment

    With ThisWorkbook.Worksheets("Sheet1")
        Set rngComent = .Range("A1:A50")
        For Each rng In rngComent
            If Not rng.Comment Is Nothing Then
                rng.Comment.Delete
            End If

            If rng.Offset(, 1) <> vbNullString Then
                Set cm = rng.AddComment
                With cm
                    .Visible = False
                    .Text rng.Offset(0, 1).Value
                End With
            End If
        Next
    End With
End Sub