Boa noite!!

Perdão, eu não entendi sua dúvida,caso não tenha relação com VBA, eu vou mover seu tópico!!

Att

Alexandre, boa noite. Quando damos um duplo click em um determinado ponto de uma td estamos fazendo a filtragem dos dados que queremos. Pois bem. Eu que gostaria de saber se há jeito de, ao fazer tal busca, também trazermos os comentários desses dados na origem.
Grato.

Boa noite!!

Eu ainda estou boiando, mas veja se te ajuda, terá que se esforçar em adaptar.

Fonte:
http://www.mrexcel.com/forum/excel-ques ... ables.html

Os códigos abaixo devem ser poste dentro do modulo de planilha

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'----When changes are made in the named range displaying
'--    PivotTable Notes, the Note database table
'--    will be updated with each New or Revised note.
 
    Dim rNotesChanged As Range, c As Range
 
    Application.ScreenUpdating = False
    If Check_Setup(Me) = False Then GoTo CleanUp
    Set rNotesChanged = Intersect(Target, _
        Range(sRngName))
    If rNotesChanged Is Nothing Then Exit Sub
    For Each c In rNotesChanged
        Call Update_Note_Database( _
            PT:=Me.PivotTables(1), _
            rNote:=Intersect(c.EntireRow, Range(sRngName)))
    Next c
CleanUp:
    Set rNotesChanged = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'----Refreshes display of PivotTable Notes from the Note database
'--    when the PivotTable is updated (refreshed, sorted, filtered, etc)
    If Check_Setup(Me) = False Then Exit Sub
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Call Refresh_Notes(PT:=Target)
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

#############
Os códigos abaixo devem ser poste dentro do modulo

Option Explicit

 
Public Const sRngName = "PT_Notes"

 
Public Function Check_Setup(ws As Worksheet) As Boolean
    Dim rNotes As Range, i As Long, bCompact As Boolean
    Dim PT As PivotTable, ptField As PivotField
    Dim tblNotes As ListObject
    Dim wsSave As Worksheet

 
'---Check if not exactly one PT on Worksheet- exit
    If ws.PivotTables.Count <> 1 Then GoTo StopNotes
    Set PT = ws.PivotTables(1)
    
'---Check if not at least one RowField and one DataField- exit
    If PT.DataFields.Count = 0 Or PT.RowFields.Count = 0 Then GoTo StopNotes
  
'---Check if Named Range "PT_Notes" doesn't exist- define it
    If Not NameExists(sRngName, ws.Name) Then
        With PT.TableRange1
            Set rNotes = Intersect(PT.DataBodyRange.EntireRow, _
                    .Resize(, 2).Offset(0, .Columns.Count))
        End With
        Set rNotes = rNotes.Resize(rNotes.Rows.Count _
            + PT.ColumnGrand)
        ws.Names.Add Name:=sRngName, RefersTo:=rNotes
        Call Format_NoteRange(rNotes)
    End If
 

'---Check if "|Notes" Worksheet doesn't exist- add it
    If Not SheetExists(ws.Name & "|Notes") Then
        Set wsSave = ActiveSheet
        Sheets.Add
        ActiveSheet.Name = ws.Name & "|Notes"
        wsSave.Activate
    End If
 

'---Check if Notes DataTable doesn't exist- add it
    With Sheets(ws.Name & "|Notes")
        On Error Resume Next
        Set tblNotes = .ListObjects(1)
        If tblNotes Is Nothing Then
            .Cells(1) = "KeyPhrase"
            .Cells(1, 2) = "Note1"
            .Cells(1, 3) = "Note2"
            Set tblNotes = .ListObjects.Add(xlSrcRange, _
                .Range("A1:C2"), , xlYes)
        End If
    End With
 

'---Check if any PT fields are not Table Headers - add
    With tblNotes
        For Each ptField In PT.RowFields
            If IsError(Application.Match(ptField.Name, .HeaderRowRange, 0)) Then
                .ListColumns.Add Position:=2
                .HeaderRowRange(1, 2) = ptField.Name
            End If
        Next ptField
    End With
    Check_Setup = True
    Exit Function
 

StopNotes:
    If NameExists(sRngName, ws.Name) Then
        Application.EnableEvents = False
        Call Clear_Notes_Range(ws)
        ws.Names(sRngName).Delete
        Application.EnableEvents = True
        Check_Setup = False
        Exit Function
    End If
End Function
 

Private Function Format_NoteRange(rNotes As Range)
'---Format body
    With rNotes
        .Interior.Color = 16316664
        .Font.Italic = True
        .HorizontalAlignment = xlLeft
        .IndentLevel = 1
        .Borders(xlInsideHorizontal).LineStyle = xlDot
        .Borders(xlBottom).LineStyle = xlDot
    End With
 
'---Format optional header
    With rNotes.Resize(1).Offset(-1)
        .Cells(1).Value = "Note1"
        .Cells(2).Value = "Note2"
        .Interior.Color = 16316664
        .Font.Italic = True
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Borders(xlBottom).LineStyle = xlContinuous
    End With
End Function
 

Private Function Clear_Notes_Range(ws As Worksheet)
'---Clear existing notes range
    On Error Resume Next
    Dim c As Range
    With ws.Range(sRngName)
        With .Offset(-1).Resize(.Rows.Count + 1)
            If Intersect(ws.PivotTables(1).TableRange2, _
                    .Cells) Is Nothing Then
                .ClearContents
                .ClearFormats
            Else 'PT overlaps notes
                For Each c In .Cells
                    c.ClearContents
                    c.ClearFormats
                Next c
                On Error GoTo 0
            End If
        End With
    End With
End Function
 

Public Function Refresh_Notes(PT As PivotTable)
    Dim sField As String, sKey As String, sFormula As String
    Dim ptField As PivotField
    Dim tblNotes As ListObject
    Dim rNotes As Range, c As Range
    Dim rLabels As Range, rLabelsAll As Range
    Dim vFields As Variant, vReturn As Variant
    Dim lPosition As Long, lOffset As Long
    Dim i As Long, lIdx As Long
    Dim lRow As Long, lCol As Long

    
'---Clear existing notes range
    Call Clear_Notes_Range(ws:=PT.Parent)
'---Redefine and format notes range
    With PT.TableRange1
        Set rNotes = Intersect(PT.DataBodyRange.EntireRow, _
            .Resize(, 2).Offset(0, .Columns.Count))
    End With
    Set rNotes = rNotes.Resize(rNotes.Rows.Count + PT.ColumnGrand)
    PT.Parent.Names(sRngName).RefersTo = rNotes
    Call Format_NoteRange(rNotes)
 
'---Make array of rowfields by position to trace each row in hierarchy

     With PT.RowFields
        ReDim vFields(1 To .Count)
        For lIdx = 1 To .Count
            vFields(PT.RowFields(lIdx).Position) = PT.RowFields(lIdx).Name
        Next lIdx
    End With
 
'---Build formula to use as Match KeyPhrase
    Set tblNotes = Sheets(PT.Parent.Name & "|Notes").ListObjects(1)
    With tblNotes
        On Error Resume Next
        sFormula = "="
        For lIdx = LBound(vFields) To UBound(vFields)
            lCol = Application.Match(vFields(lIdx), .HeaderRowRange, 0)
            sFormula = sFormula & "RC" & lCol & "&""|""&"
        Next lIdx
        sFormula = Left(sFormula, Len(sFormula) - 1)
        Intersect(.DataBodyRange, .ListColumns(1).Range).FormulaR1C1 = sFormula
    End With
 
'---Match KeyPhrases for each visible row of PT
    Application.EnableEvents = False
    With PT.TableRange1
        lOffset = .Column + .Columns.Count - PT.DataBodyRange.Column + 1
    End With
    
    With PT.DataBodyRange.Resize(, 1)
        For lRow = 1 To .Rows.Count + PT.ColumnGrand
            sKey = GetKey(rPC:=.Cells(lRow), vFields:=vFields)
            vReturn = Evaluate("=MATCH(""" & _
                sKey & """," & tblNotes.Name & "[KeyPhrase],0)")
            If (Not IsError(vReturn)) Then
                .Cells(lRow, lOffset) = Evaluate("=INDEX(" & tblNotes.Name & "[Note1]," & vReturn & ")")
                .Cells(lRow, lOffset + 1) = Evaluate("=INDEX(" & tblNotes.Name & "[Note2]," & vReturn & ")")
            End If
        Next lRow
    End With
    Application.EnableEvents = True
End Function


Private Function GetKey(rPC As Range, vFields As Variant) As String
    Dim i As Long
    Dim sNew As String
    
    With rPC.PivotCell.RowItems
        For i = LBound(vFields) To UBound(vFields)
            If i > .Count Then sNew = "" Else sNew = .Item(i).Caption
            GetKey = GetKey & sNew & "|"
        Next i
    End With
 End Function

Public Function Update_Note_Database(PT As PivotTable, rNote As Range)
    Dim tblNotes As ListObject
    Dim rPC As Range
    Dim iArray As Variant, i As Integer
 
    '---Make new record of note at top of database table
    Set tblNotes = Sheets(PT.Parent.Name & "|Notes").ListObjects(1)
    tblNotes.ListRows.Add (1)
    tblNotes.ListColumns("Note1").Range(2) = rNote(1).Value
    tblNotes.ListColumns("Note2").Range(2) = rNote(1, 2).Value
    
    Set rPC = Intersect(PT.DataBodyRange.Resize(, 1), rNote.EntireRow)
    With rPC.PivotCell.RowItems
        For i = 1 To .Count
            With .Item(i)
                tblNotes.ListColumns(.Parent.Name).Range(2) = .Caption
            End With
        Next i
    End With
    
'---Remove any previous notes with matching rowfield values
    With tblNotes.Range
        ReDim iArray(0 To .Columns.Count - 4)
        For i = 0 To UBound(iArray)
            iArray(i) = i + 2
        Next i
        .RemoveDuplicates Columns:=(iArray), Header:=xlYes
        If rNote(1).Value = "" And rNote(1, 2).Value = "" Then _
            tblNotes.ListRows(1).Delete
    End With
End Function
  
Private Function NameExists(sRngName As String, _
        sSheetName As String) As Boolean
    Dim rTest As Range
    On Error Resume Next
    Set rTest = Sheets(sSheetName).Range(sRngName)
    NameExists = Not rTest Is Nothing
End Function
 

Private Function SheetExists(sSheetName As String) As Boolean
    Dim sTest As String
    On Error Resume Next
    sTest = Worksheets(sSheetName).Name
    SheetExists = LCase(sTest) = LCase(sSheetName)
End Function

Olá Alexandre, tudo bem?
Obrigado por tua ajuda. Não é bem essa a minha intensão.O meu objetivo é fazer com que os dados que estão na planilha de origem sejam filtrados trazendo na tabela editada os comentários que lá estão.
Dessa forma eu teria mais eficácia na coleta dos dados. A grande maioria dos usuários costumam atribuir comentários em diversos pontos da planilha. Então, o meio prático de enxergar todo o conteúdo, seria filtrar as células que tenham comentário também.
Grato mais uma vez.