excel - 将文本粘贴到 Excel 注释 VBA

Question

我无法找到或创建 VBA 代码以允许将复制的文本从另一个工作表(工作表 2)中的一个单元格粘贴到另一个工作表(工作表 1)中先前创建的注释中。

这是迄今为止我成功编译的代码，我一直在纠结如何将找到的文本放入评论框中。

Sub For_Reals()

'Add Comment
Sheets("Sheet1").Range("F2").AddComment
Range("F2").Comment.Visible = False

'Find Value in Sheet2 based on Value from Sheet1
Dim FindString As String
    Dim Rng As Range
    FindString = Sheets("Sheet1").Range("F2").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet2").Range("C:C")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If

'Copy Value 4 cells to the right of found Value
Selection.Offset(0, 4).Copy

'Need Code to paste copied value in previously created comment

End Sub

Answer 1

您无需将单元格值复制并粘贴到注释中，而是在创建注释框的同时创建文本。如果评论框已经存在，则会引发错误 - 因此请事先删除该单元格中的所有评论框。

VBA 帮助给出了一个例子:

Worksheets(1).Range("E5").AddComment "Current Sales"

所以考虑到这一点，这段代码就可以解决问题:

Sub For_Reals()

    'Find Value in Sheet2 based on Value from Sheet1
    Dim FindString As String
    Dim Rng As Range
    FindString = Sheets("Sheet1").Range("F2").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet2").Range("C:C")
            Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
            'Remove any existing comments, create comment and add text.
            If Not Rng Is Nothing Then
                Sheets("Sheet1").Range("F2").ClearComments
                Sheets("Sheet1").Range("F2").AddComment Rng.Offset(0, 4).Value
                Range("F2").Comment.Visible = True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If

End Sub