时间戳

首页 > 解决方案 > 我可以将 VBA 中的计算值添加到单元格的悬停鼠标悬停中吗？

excel - 我可以将 VBA 中的计算值添加到单元格的悬停鼠标悬停中吗？

问题描述

我想知道 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

标签： excelvba

解决方案

您需要将代码添加到事件中 - 无论是在工作表计算时，还是在特定单元格更改时。

此代码将更改已添加到的注释中的文本Sheet1!D7。
如果单元格尚未包含注释，您将收到运行时错误 91 - Object variable 或 With block variable not set。

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。

推荐阅读