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