Question

我有一个VBA脚本，可以将注释添加到后台工作表中，这样做很有效。我遇到的问题是将其移至前面的工作表。

我可以使用复制和粘贴特殊的xlPasteComments但这确实会减慢更新过程。我在下面列出了将重复代码的部分。如果我使用值，它不包括注释（我将其留在显示中）并且我已经尝试将Dim分离出来但这只会导致错误而对象不被支持。

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数组中的所有注释，然后使用此注释数组写入另一个工作表。

所以，我试图调整这个technique from Chip Pearson's website来完成那个但是对于单元格值。

不幸的是，在具有多个单元格的范围上使用.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

将评论从一个工作表转移到另一个工作表而不使用剪贴板

2 个答案: