如何为包含特定注释的单元格返回单元格引用?

时间:2019-04-25 15:27:34

标签: excel vba

我编写了一个VBA子例程,以在Excel工作表的注释(现在称为注释)中搜索特定的文本字符串。我希望代码返回包含特定注释的单元格的地址(即单元格引用)。但是,编写的代码似乎返回单元格中的值,而不是单元格的地址。

我尝试过更改行:

Set RefCell = cmt.Parent

在下面的代码中,以:

Set RefCell = cmt.Parent.Address

根据我发现的另一种解决方案。但是,这会导致运行时错误“ 424”“需要对象”。

我感谢任何人都可以提供的帮助。

Public Sub CommentLocator(Sht As Worksheet, RefCell As Range, CommentID As String)

    Dim Message As String, Title As String

    Dim cmt As Comment

    'On Error GoTo ErrorTrap

    'Clear previous value of RefCell
    Set RefCell = Nothing

    'Searches all comments on the worksheet for specific text string _
    and returns the range of the parent cell
    For Each cmt In Sht.Comments
        If cmt.Text = CommentID Then
            Set RefCell = cmt.Parent
            Exit Sub
        End If
    Next cmt

    If RefCell Is Nothing Then

        'Display error message
        Message = "Error!" & vbCrLf & _
            "No viable comments found on sheet '" & Sht.Name & "'" & vbCrLf & vbCrLf & _
            "Seek technical assistance."
        Title = "Error"

        MsgBox Message, vbExclamation + vbOKOnly, Title

    End If

Exit Sub

我希望RefCell返回单元格引用/地址,但它返回单元格中的值。

3 个答案:

答案 0 :(得分:1)

您需要使用RefCell.Address来获取单元格引用。在此行Set上使用Set RefCell = cmt.Parent.Address会得到一个Object,但是您却向它传递了一个String,这就是为什么会出现错误的原因

请尝试以下操作

If RefCell Is Nothing Then
    'Display error message
    Message = "Error!" & vbCrLf & _
        "No viable comments found on sheet '" & Sht.Name & "'" & vbCrLf & vbCrLf & _
        "Seek technical assistance."
    Title = "Error"

    MsgBox Message, vbExclamation + vbOKOnly, Title
Else
    MsgBox RefCell.Address
End If

答案 1 :(得分:0)

您可以使用SpecialCells遍历所有带有注释(注释)的单元格:

On Error Resume Next
Set CommentCells = ActiveSheet.Range("A1").SpecialCells(xlCellTypeComments)
On Error GoTo 0
If CommentCells Is Nothing Then
    Exit Sub
End If

然后,要对注释执行任何操作,请使用以下命令遍历所有带有注释的单元格:

For each RefCell in CommentCells
    'Do something 
Next RefCell

答案 2 :(得分:0)

已解决。

基本上,我的问题是我需要将变量定义为范围时将其定义为范围。

感谢那些发表评论的人-您对我提供此解决方案非常有帮助。

这是我的完整解决方案:

'Require all variables to be declared
Option Explicit

'Public Variable Declarations
Public Message As String, Title As String


Public Sub CommentLocator(ByVal ObjectiveCommentID As String, _
           ByVal VariableCommentID As String, ByRef ObjectiveCell As String, _
           ByRef VariableCell As String)

    Dim cmt As Comment

    On Error GoTo ErrorTrap


    'Searches all comments on the active worksheet for specific text strings _
    represented by 'ObjectiveCommentID' and 'VariableCommentID' and returns the _
    addresses of the parent cells as strings
    For Each cmt In ActiveSheet.Comments
        If cmt.Text = ObjectiveCommentID Then
            ObjectiveCell = cmt.Parent.Address
        ElseIf cmt.Text = VariableCommentID Then
            VariableCell = cmt.Parent.Address
        End If
    Next cmt


    'Displays error message if no viable '$OBJECTIVE' comments found on sheet
    If ObjectiveCell = "" Then

        Message = "Runtime Error!" & vbCrLf & vbCrLf & _
            "No viable '" & ObjectiveCommentID & "' comments found on sheet" & vbCrLf _
            & "'" & ActiveSheet.Name & "'" & vbCrLf & vbCrLf & _
            "Check and update comments (notes) and try again."
        Title = "Error!"

        MsgBox Message, vbExclamation + vbOKOnly, Title

    End If


    'Displays error message if no viable '$VARIABLE' comments found on sheet
    If VariableCell = "" Then

        Message = "Runtime Error!" & vbCrLf & vbCrLf & _
            "No viable '" & VariableCommentID & "' comments found on sheet" & vbCrLf _
            & "'" & ActiveSheet.Name & "'" & vbCrLf & vbCrLf & _
            "Check and update comments (notes) and try again."
        Title = "Error!"

        MsgBox Message, vbExclamation + vbOKOnly, Title

    End If


Exit Sub


ErrorTrap:

    'Set calculation mode to auto & enable events
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    'Enable screen updating & status bar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True

    'Display error message
    Message = "Fatal Error!" & vbCrLf & _
        "Error in subroutine 'CommentLocator'." & vbCrLf & _
        "Seek technical assistance."
    Title = "Error!"

    MsgBox Message, vbExclamation + vbOKOnly, Title

End Sub