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

Question

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

我一直在使用来自提到@ Dy.Lee下面的代码试图在这里 ，但不幸的是它给了我一个运行时错误“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

有人可以请您找出错误或为此建议更好的解决方案吗？

Answer 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

Answer 2

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

Answer 3

类似于以下内容，您可以使用“ 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