不使用剪贴板将注释从一个工作表传输到另一个工作表

Question

我有一个VBA脚本，它将注释添加到后台工作表中，这非常有用。我遇到的问题是把它移到前面的工作表上。

我可以使用复制和粘贴特殊的xlPasteComments，但这确实减慢了更新过程。我已经在下面的一节中包含了将重复的代码。如果我使用值，它不包括注释(我留下了这个以显示)，并且我尝试将它们分隔开，但是这只是导致错误，对象不受支持。

If ws.Range("B9") = ("January") Then
Dim a As Long
Dim b As Long
    ws.Range("J8:AN51").Value = area.Range("E2:AI45").Value
    'This brings up a 438 runtime error (object doesnt support this propery 
    or method)
    a = ws.Range("J8:AN51").Comments
    b = area.Range("E2:AI45").Comments
    a = b
    'area.Range("E2:AI45").Copy
    'ws.Range("J8:AN51").PasteSpecial xlPasteComments
    ws.Range("J62:AN63").Value = area1.Range("E47:AI48").Value
    ws.Range("J55:AN55").Value = area.Range("E52:AI52").Value

我已经在Google上查过了，但是它只是不断地提到如何在一个单元格中复制值，我想要的只是注释(因为这些值已经被复制了)。

Answer 1

我最初的想法是尝试加载VBA数组中的所有注释，然后使用这个注释数组写入其他工作表。

所以，我试着调整这个奇普·皮尔逊网站的技术，它可以做到这一点，但只针对单元格值。

不幸的是，在包含多个单元格的范围内使用.comment.text不会返回数组，这意味着该方法无法工作。

这意味着，为了使用VBA将注释传输到另一个工作表，您需要逐个遍历范围内的所有单元格(可能作为一个集合)。虽然我确信这是可行的，但它很可能不会比使用xlPasteComments更快。

然后，我决定使用通常的VBA技术，通过禁用某些设置，如自动计算、屏幕更新和事件，使宏运行得更快。下面是我如何实现它的一个例子(包括一些错误处理)：

Sub Optimize_VBA_Performance_Example()
    Const proc_name = "Optimize_VBA_Performance_Example"

    'Store the initial setting to reset it at the end
    Dim Initial_xlCalculation_Setting As Variant
    Initial_xlCalculation_Setting = Application.Calculation

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    On Error GoTo Error_handler



    'Your code



    'Restore initial settings (before exiting macro)
    With Application
        .Calculation = Initial_xlCalculation_Setting
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayStatusBar = True
    End With

Exit Sub

Error_handler:

    'Restore initial settings (after error)
    With Application
        .Calculation = Initial_xlCalculation_Setting
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayStatusBar = True
    End With

    'Display error message
    Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
                "While running: " & proc_name & vbNewLine, _
                vbCritical, "Error")

End Sub

Answer 2

如果您只关心注释的文本(而不是格式)，则可以使用Range.Comment.Text对象复制注释文本。无论是否存在注释，处理错误都会产生主要的困难。然后循环遍历源范围中的所有单元格，并将注释分配给目标区域。

Sub copyComment(source As Range, dest As Range)
    Dim t As String
    ' first set up error handling to exit the sub if the source cell doesn't have a comment
    On Error GoTo ExitCopyComment
    t = source.Comment.Text
    ' change error handling to go to next line
    On Error Resume Next
    ' assign the text to an existing comment at the destination
    ' use this 1,1 offset (first cell in range) syntax to overcome parser
    ' issue about assignment to constant
    dest(1, 1).Comment.Text = t
    ' if that produced an error then we need to add a comment
    If (Err) Then
        dest.AddComment t
    End If

ExitCopyComment:
    ' clear error handling
    On Error GoTo 0
End Sub

Sub test()
    Dim cell As Range
    Sheet1.Activate
    ' loop through all cells in source
    For Each cell In Sheet1.Range("E47:AI48").Cells
        ' calculate destination range as offset from source cell
        Call copyComment(cell, Sheet2.Cells(cell.Row + 15, cell.Column + 5))
    Next cell
End Sub