将注释插入另一个单元格 Excel 中的最后一个单元格

Question

我在 VBA Excel 2010 中编写了一个代码，它从 sheet2 将数据发送到 sheet1 并通过按钮提交非常有效。 但是我有一个单元格，在提交之后需要将此数据发送到另一张表作为最后一个单元格的注释。 例如：

Dim ws1, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set rngk = ws2.Range("B5")

com = ws2.Range("B9")
k = Application.WorksheetFunction.VLookup(rngk, ws2.Range("D5:E6").Value, 2, False)

lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
ws1.Cells(lastRow, 3) = k

现在在等于 k ​​(LastRow, 3) 的同一个单元格上，我想从另一张表的单元格 B9 添加评论。

如何在此单元格中添加 B9 评论！

谢谢

Answer 1

首先检查您复制的单元格是否有使用Not SourceCell.Comment Is Nothing之类的注释。
如果它有评论，那么只需将目标单元格值设置为评论的文本。

Sub Test()

    Dim TargetCell As Range
    Dim SourceCell As Range


    Set TargetCell = ThisWorkbook.Worksheets("Sheet1").Range("H5")
    Set SourceCell = ThisWorkbook.Worksheets("Sheet2").Range("B9")

    If HasComment(SourceCell) Then
        TargetCell.Value = SourceCell.Comment.Text
    End If

End Sub

Public Function HasComment(Target As Range) As Boolean

    On Error GoTo ERROR_HANDLER

    If Target.Cells.Count = 1 Then
        With Target
            HasComment = Not .Comment Is Nothing
        End With
    Else
        Err.Raise vbObjectError + 513, "HasComment()", "Argument must reference single cell."
    End If

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " " & Err.Description & " in procedure Module1.HasComment."
            Err.Clear
            Application.EnableEvents = True
    End Select

End Function  

编辑：

这将从Sheet2 中获取值，并将其放入保存Sheet1 中最后一行数据的 cmets：

Sub Test()

    Dim TargetColumns As Variant
    Dim SourceCells As Range
    Dim rCell As Range
    Dim rAddToCell As Range
    Dim x As Long

    TargetColumns = Array(6, 10, 15, 17) 'Column numbers to place into.
    Set SourceCells = ThisWorkbook.Worksheets("Sheet2").Range("B9,B15,B22,B26")

    'Look at each cell in turn.
    For Each rCell In SourceCells

        'Find the last cell in the correct column.
        Set rAddToCell = LastCell(ThisWorkbook.Worksheets("Sheet1"), CLng(TargetColumns(x)))

        'If there's already a comment then delete it first
        'Then add value from SourceCell into comment in Target column.
        With rAddToCell
            If HasComment(rAddToCell) Then
                .ClearComments
            End If
            .AddComment
            .Comment.Text Text:=rCell.Value
        End With

        x = x + 1
    Next rCell

End Sub

Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With wrkSht
        If Col = 0 Then
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Else
            lLastCol = Col '.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
        End If

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0

End Function

Public Function HasComment(Target As Range) As Boolean

    On Error GoTo ERROR_HANDLER

    If Target.Cells.Count = 1 Then
        With Target
            HasComment = Not .Comment Is Nothing
        End With
    Else
        Err.Raise vbObjectError + 513, "HasComment()", "Argument must reference single cell."
    End If

    On Error GoTo 0
    Exit Function

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " " & Err.Description & " in procedure Module1.HasComment."
            Err.Clear
            Application.EnableEvents = True
    End Select

End Function