Могу ли я добавить вычисленное значение в VBA при наведении курсора на ячейку?

Question

Мне было интересно, можно ли VBA что-то вычислить, а затем поместить эту информацию так, чтобы при наведении курсора на ячейку я видел эту информацию.Сама ячейка будет содержать другое значение ...

Например:

.Cells.Value = Round((ds.Cells(x, 57).Value _
                / ds.Cells(x, 40).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 57).Value & "/" & ds.Cells(x, 40).Value & ")"

.Cells(ltaLR + 1, "K").Value = Round((ds.Cells(x, 71).Value _
                / ds.Cells(x, 41).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 71).Value & "/" & ds.Cells(x, 41).Value & ")"

Можно ли разделить этот код на две части, чтобы добавить

& ds.Cells(x, 71).Value & "/" & ds.Cells(x, 41).Value

наведите курсор мыши?

Я хочу включить его в этот код:

Sub LTATradesTest()

Application.ScreenUpdating = False

Dim LastRow As Long, fs As Worksheet, ds As Worksheet, x As Long
Dim ltaLR As Long

With ThisWorkbook
    Set fs = .Worksheets("Filters")
    Set ds = .Worksheets("Data")
End With

LastRow = ds.Cells.Find("*", LookIn:=xlFormulas, Lookat:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

ClearSelections
SortData
DeleteCF

For x = 4 To LastRow

    If ds.Cells(x, 1) = ds.Range("E1") And ds.Cells(x, 40) >= _
        fs.Range("C2") And ds.Cells(x, 41) >= fs.Range("C2") Then

        With ThisWorkbook.Worksheets("LTA")

            ltaLR = .Cells.Find("*", LookIn:=xlFormulas, Lookat:=xlWhole, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

            .Cells(ltaLR, "B").Value = ds.Cells(x, 3)
            .Cells(ltaLR, "B").Resize(2, 1).Merge
            .Cells(ltaLR, "C").Value = ds.Cells(x, 4)
            .Cells(ltaLR + 1, "C").Value = ds.Cells(x, 5)
            .Cells(ltaLR, "D").Value = ds.Cells(x, 81)
            .Cells(ltaLR + 1, "D").Value = ds.Cells(x, 91)
            .Cells(ltaLR, "E").Value = ds.Cells(x, 82)
            .Cells(ltaLR + 1, "E").Value = ds.Cells(x, 92)
            .Cells(ltaLR, "F").Value = ds.Cells(x, 83)
            .Cells(ltaLR + 1, "F").Value = ds.Cells(x, 93)
            .Cells(ltaLR, "G").Value = ds.Cells(x, 84)
            .Cells(ltaLR + 1, "G").Value = ds.Cells(x, 94)
            .Cells(ltaLR, "H").Value = ds.Cells(x, 85)
            .Cells(ltaLR + 1, "H").Value = ds.Cells(x, 96)
            .Cells(ltaLR, "I").Value = ds.Cells(x, 95)
            .Cells(ltaLR + 1, "I").Value = ds.Cells(x, 86)
            .Cells(ltaLR, "J").Value = ds.Cells(x, 88)
            .Cells(ltaLR + 1, "J").Value = ds.Cells(x, 98)

            .Cells(ltaLR, "K").Value = Round((ds.Cells(x, 57).Value _
                / ds.Cells(x, 40).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 57).Value & "/" & ds.Cells(x, 40).Value & ")"
            .Cells(ltaLR + 1, "K").Value = Round((ds.Cells(x, 71).Value _
                / ds.Cells(x, 41).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 71).Value & "/" & ds.Cells(x, 41).Value & ")"
            .Cells(ltaLR, "L").Value = Round((ds.Cells(x, 58).Value _
                / ds.Cells(x, 40).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 58).Value & "/" & ds.Cells(x, 40).Value & ")"
            .Cells(ltaLR + 1, "L").Value = Round((ds.Cells(x, 72).Value _
                / ds.Cells(x, 41).Value) * 100, 0) & "% (" _
                & ds.Cells(x, 72).Value & "/" & ds.Cells(x, 41).Value & ")"

            .Cells(ltaLR, "M").Value = Round(((ds.Cells(x, 229).Value _
                + ds.Cells(x, 243).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 229).Value + ds.Cells(x, 243).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR + 1, "M").Value = Round(((ds.Cells(x, 257).Value _
                + ds.Cells(x, 275).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 257).Value + ds.Cells(x, 275).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR, "N").Value = Round(((ds.Cells(x, 54).Value + _
                ds.Cells(x, 68).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 54).Value + ds.Cells(x, 68).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR + 1, "N").Value = Round(((ds.Cells(x, 55).Value _
                + ds.Cells(x, 69).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 55).Value + ds.Cells(x, 69).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR, "O").Value = Round(((ds.Cells(x, 56).Value _
                + ds.Cells(x, 70).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 56).Value + ds.Cells(x, 70).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR + 1, "O").Value = Round(((ds.Cells(x, 59).Value _
                + ds.Cells(x, 73).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 59).Value + ds.Cells(x, 73).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR, "P").Value = Round(((ds.Cells(x, 144).Value _
                + ds.Cells(x, 159).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 144).Value + ds.Cells(x, 159).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"
            .Cells(ltaLR + 1, "P").Value = Round(((ds.Cells(x, 147).Value _
                + ds.Cells(x, 162).Value) / (ds.Cells(x, 40).Value _
                + ds.Cells(x, 41).Value)) * 100, 0) & "% (" _
                & (ds.Cells(x, 147).Value + ds.Cells(x, 162).Value) & "/" _
                & (ds.Cells(x, 40).Value + ds.Cells(x, 41).Value) & ")"

        End With
End Sub

Answer 1

Вам нужно будет добавить код к событию - либо при расчете листа, либо при изменении конкретной ячейки.

Этот код изменит текст в комментарии, который был добавлен к Sheet1!D7.
Если в ячейке еще нет комментария, вы получите ошибку времени выполнения 91 - Переменная объекта или С переменной блока не установлено .

Private Sub Worksheet_Calculate()

    Dim ds As Worksheet
    Dim x As Long

    Set ds = ThisWorkbook.Worksheets("Sheet1")
    x = 4

'    Reference the comment by name.
'    ThisWorkbook.Worksheets("Sheet1").Shapes("Comment 2") _
'        .TextFrame.Characters.Text = ds.Cells(x, 71) & "/" & ds.Cells(x, 41)

'    Reference the comment in the cell range.
    ThisWorkbook.Worksheets("Sheet1").Range("D7").Comment.Text _
        Text:=ds.Cells(x, 71) & "/" & ds.Cells(x, 41)

'    Look at each comment on the sheet.
'    Numerics must be converted to text (Cstr).
'    Dim cmt As Comment
'    For Each cmt In ThisWorkbook.Worksheets("Sheet1").Comments
'        If cmt.Shape.Name = "Comment 1" Then
'            cmt.Text Text:=CStr(Rnd(5))
'        End If
'    Next cmt

End Sub  

Редактировать:
Для включения в ваш код вы можете использовать код, подобный приведенному ниже.Я добавил два метода - один обновляет комментарий, если он существует, другой удаляет его и вставляет его заново.
Эти комментарии останутся статичными, если вы не добавите код для их изменения при обновлении вычислений.

Sub LTATradesTest()

    Dim ds As Worksheet
    Dim x As Long
    Dim ltaLR As Long
    Dim cmntText As String
    Dim LastRow As Long

    Set ds = ThisWorkbook.Worksheets("Data")
    ltaLR = 3
    LastRow = 20

    With ThisWorkbook.Worksheets("LTA")
        For x = 4 To LastRow

            '.....
            '.Cells(ltaLR + 1, "J").Value = ds.Cells(x, 98)

            .Cells(ltaLR, "K").Value = Round((ds.Cells(x, 57).Value _
                            / ds.Cells(x, 40).Value) * 100, 0) & "%"

'            Adds or updates the comment text.
'            cmntText = ds.Cells(x, 57).Value & "/" & ds.Cells(x, 40).Value
'            If Not HasComment(.Cells(ltaLR, "K")) Then
'                .Cells(ltaLR, "K").AddComment Text:=cmntText
'            Else
'                .Cells(ltaLR, "K").Comment.Text Text:=cmntText
'            End If

'           Deletes and reinserts the comment.
            If HasComment(.Cells(ltaLR, "K")) Then
                .Cells(ltaLR, "K").Comment.Delete
            End If
            .Cells(ltaLR, "K").AddComment Text:=ds.Cells(x, 57).Value & "/" & ds.Cells(x, 40).Value

            '....

        Next x
    End With

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

Ваш код выглядит так, как будто он обновляет одни и те же ячейки с разными значениями x.