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

【问题标题】：Excel-VBA macro to transform cell content into a comment of another cellExcel-VBA 宏将单元格内容转换为另一个单元格的注释
【发布时间】：2018-08-16 11:18:25
【问题描述】：

我有个看似简单的目标，就是把B列的内容变成A列的cmets。

我曾尝试使用@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

请有人指出错误或为此提出更好的解决方案吗？

【问题讨论】：

错误在哪一行？
试试.Text Text:=rngDB(i).text 以确保它是一个字符串？
@QHarr - 错误出现在 .Text Text:=rngDB(i).value

标签： vba excel comments

【解决方案1】：

我会走这条路（cmets 中的解释）：

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

【讨论】：

【解决方案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

【讨论】：

【解决方案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

除了添加空白 cmets，您还可以将此回合翻转为：

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

【讨论】：