Question

目标：我正在寻找已过滤序列的数据点的参考行数，这些数据点是在两个单独的工作表中进行散点图绘制的。

我正在遵循这些指南，但收效甚微：

场景：：我有两个包含表格格式相同数据的表格：

+-----+-------------+---------+---------+-------+
| Row | Description | X-value | Y-value | Score |
+-----+-------------+---------+---------+-------+
|   1 | "Something" |     3.4 |     4.5 |   7.0 |
|   2 | "Something" |     2.3 |     2.4 |   5.6 |
| ... | ...         |     ... |     ... |   ... |
| 100 | "Something" |     6.5 |     4.2 |   8.0 |
+-----+-------------+---------+---------+-------+

每张纸的x值和y值已散点绘制在同一张图表上。

我有一个VBA脚本，当鼠标悬停在图表上时，该脚本将返回特定数据点（Arg1，ser.Values，ser.XValues）的系列索引，x和y坐标：

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_point As Long
Dim chrt As Chart
Dim ser As Series
Dim score As Double
Dim desc As String

On Error Resume Next    

Me.GetChartElement x, y, ElementID, Arg1, Arg2

Application.ScreenUpdating = False
Set chrt = ActiveChart
Set ser = ActiveChart.SeriesCollection(Arg1)
'x and y values
chart_data = ser.Values
chart_label = ser.XValues

如果列表未过滤，则该系列的点索引似乎与行号匹配，因此我可以很容易地获取该行的引用并提取信息：

If Arg1 = 1 Then
score = Sheet1.Cells(Arg2 + 1, "E").Value
desc = Sheet1.Cells(Arg2 + 1, "B").Value
End If

If Arg1 = 2 Then
score = Sheet2.Cells(Arg2 + 1, "E").Value
desc = Sheet2.Cells(Arg2 + 1, "B").Value
End If

复杂度：：每个工作表都会根据得分过滤并动态更新图表，因此每个工作表中的行数可能不连续。有些行是隐藏的。

以上索引不再与正确的行匹配，因此我的代码返回了错误的信息。

例如。分数> 6

+-----+-------------+---------+---------+-------+
| Row | Description | X-value | Y-value | Score |
+-----+-------------+---------+---------+-------+
|   1 | "Something" |     3.4 |     4.5 |   7.0 |
| 100 | "Something" |     6.5 |     4.2 |   8.0 |
+-----+-------------+---------+---------+-------+

结果：我想使用x，y值搜索每张纸上的可见列表并检索行号。这样我就可以检索描述并进行评分，以将其放入鼠标悬停的弹出消息中。

我是VBA的新手，非常感谢指导。

更新1：：显示代码进行鼠标悬停并采用DisplayName的答案。它不适用于所有数据点，并显示一个空白框。当前正在尝试调试。与我的原始代码进行比较时，没有对行进行过滤。

说明：X值（和Y）可以相同。如果X和Y重复，则返回第一个匹配就可以了。

Set txtbox = ActiveSheet.Shapes("hover")

If ElementID = xlSeries And Arg1 <= 2 Then
' Original code that only works on un-filtered rows in Sheet 1 & 2
'    If Arg1 = 1 Then
'        score = Sheet1.Cells(Arg2 + 1, "E").Value
'        desc = Sheet1.Cells(Arg2 + 1, "B").Value
'    ElseIf Arg1 = 2 Then
'        score = Sheet2.Cells(Arg2 + 1, "E").Value
'        desc = Sheet2.Cells(Arg2 + 1, "B").Value
'    End If

' Code from DisplayName
    With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name)) ' reference Sheet1 if Arg1=1 and Sheet2 if Arg1=2
        With .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).Find(what:=chart_label(Arg2), LookIn:=xlValues, lookat:=xlWhole) ' search reference referenced sheet x-values range for current x-value
            If .Offset(, 1).Value = chart_data(Arg2) Then 'check y-value
                score = .Offset(, 2).Value     ' assign 'score' the value of found cell offset two columns to the right
                desc = .Offset(, -1).Value ' assign 'desc' the value of found cell offset one column to the left
            End If
        End With
    End With

    If Err.Number Then
        Set txtbox = ActiveSheet.Shapes.AddTextbox _
                                        (msoTextOrientationHorizontal, x - 150, y - 150, 300, 50)
        txtbox.Name = "hover"
        txtbox.Fill.Solid
        txtbox.Fill.ForeColor.SchemeColor = 9
        txtbox.Line.DashStyle = msoLineSolid
        chrt.Shapes("hover").TextFrame.Characters.Text = "Y: " & Application.WorksheetFunction.Text(chart_data(Arg2), "?.?") & _
                                                                                        ", X: " & Application.WorksheetFunction.Text(chart_label(Arg2), "?.?") & _
                                                                                        ", Score: " & Application.WorksheetFunction.Text(score, "?.?") & ", " & desc
        With chrt.Shapes("hover").TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 12
            .ColorIndex = 16
        End With
        last_point = Arg2
    End If
    txtbox.Left = x - 150
    txtbox.Top = y - 150

Else
    txtbox.Delete
End If
Application.ScreenUpdating = True
End Sub

更新2：正如蒂姆·威廉姆斯（Tim Williams）指出的那样，如果不遍历整个范围，就无法解决这个问题。我将他的伪代码与DisplayName的示例结合在一起，以获得所需的行为，其中将x，y进行比较以获取分数和描述。这是起作用的代码：

   With Worksheets(Choose(Arg1, Sheet1.Name, Sheet2.Name))
            For Each row In .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible)
                If row.Value = chart_label(Arg2) And row.Offset(, 1).Value = chart_data(Arg2) Then
                    score = row.Offset(, 2).Value
                    desc = row.Offset(, -1).Value
                    Exit For
                End If
            Next row
    End With

我希望我可以在Tim Williams和Display Name之间分配赏金。由于我只能选择一个，所以奖项归Tim。

Answer 1

您可以执行以下操作：

'called from your event class using Arg1 and Arg2
Sub HandlePointClicked(seriesNum As Long, pointNum As Long)

    Dim vis As Range, c As Range, i As Long, rowNum As Long
    Dim sht As Worksheet

    ' which sheet has the source data?
    Set sht = GetSheetFromSeriesNumber(seriesMum) 

    'Get only the visible rows on the source data sheet
    '   (adjust to suit your specific case...)
    Set vis = sht.Range("A2:A100").SpecialCells(xlCellTypeVisible)

    'You can't index directly into vis 
    '  eg. vis.Cells(pointNum) may not work as you might expect
    '  so you have (?) to do something like this loop
    For Each c In vis.Cells
        i = i + 1
        If i = pointNum Then rowNum = c.Row
    Next c

    Debug.Print rowNum '<< row number for the activated point

End Sub

Answer 2

为弥补我先前尝试不回答您问题的细节并防止专家删除我删除的答案的尝试，我提供了另一种解决方案。但是在讨论所有代码之前，我必须承认@Tim Williams已经提供了最佳解决方案，并且认为只有他的回答值得接受（直到日期）。我发现没有其他选择可以获取不循环的行号。

我只是试图将各个部分放在一起并与您的代码集成。我采取了以下自由行动

使用类模块直接编码Chart_MouseMove可能会在修改/使用图表时变得麻烦。
图表仅放置在工作表上
使用已经放置在图表上的固定文本框，以避免删除和重新创建该文本框。可能会导致运行时错误问题
避免禁用屏幕更新和错误旁路。您可以根据需要修改代码。

现在首先插入一个名为CEvent的类模块。在课程模块中添加

Public WithEvents Scatter As Chart
Private Sub Scatter_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_point As Long
Dim chrt As Chart
Dim Ser As Series
Dim score As Double
Dim desc As String
Dim VRng, Cl As Range, SerStr As String, part As Variant, Txt As Shape
'On Error Resume Next
Set chrt = ActiveChart
chrt.GetChartElement X, Y, ElementID, Arg1, Arg2

'Application.ScreenUpdating = False

'x and y values

If ElementID = xlSeries And Arg1 <= 2 Then
Set Ser = ActiveChart.SeriesCollection(Arg1)
SerStr = Ser.Formula
part = Split(SerStr, ",")
Set VRng = Range(part(1)).SpecialCells(xlCellTypeVisible)
Vrw = 0
    For Each Cl In VRng.Cells
    Vrw = Vrw + 1
        If Vrw = Arg2 Then
        Exit For
        End If
    Next
score = Cl.Offset(, 2).Value
desc = Cl.Offset(, -1).Value
chart_data = Cl.Value
chart_label = Cl.Offset(, 1).Value

     Set Txt = ActiveSheet.Shapes("TextBox 2")

     'Txt.Name = "hover"
     Txt.Fill.Solid
     Txt.Fill.ForeColor.SchemeColor = 9
     Txt.Line.DashStyle = msoLineSolid
     Txt.TextFrame.Characters.Text = "Y: " & chart_label & ", X: " & chart_data & ", Score: " & score & ", " & vbCrLf & desc
        With Txt.TextFrame.Characters.Font
            .Name = "Arial"
            .Size = 12
            .ColorIndex = 16
        End With
      last_point = Arg2
      'Txtbox.Left = X - 150
      'Txtbox.Top = Y - 150
Else
'Txt.Visible = msoFalse
End If
'Application.ScreenUpdating = True
End Sub

然后在标准模块中

Dim XCEvent As New CEvent
Sub InitializeChart()
Set XCEvent.Scatter = Worksheets(1).ChartObjects(1).Chart
Worksheets(1).Range("I25").Value = "Scatter Scan Mode On"
Worksheets(1).ChartObjects("Chart 1").Activate
End Sub
Sub ReleaseChart()
Set XCEvent.Scatter = Nothing
Worksheets(1).Range("I25").Value = "Scatter Scan Mode Off"
End Sub

sub InitializeChart() & ReleaseChart()可以分配给工作表上图表旁边的按钮。请适当修改工作表名称，地址，图表名称，文本框名称等。它正在使用经过班次过滤的数据

希望这会有用

Answer 3

您必须找到具有当前x值的单元格，然后从其偏移量

所以替代：

"Cannot set property 'dependencies' of undefined"

具有：

If Arg1 = 1 Then
score = Sheet1.Cells(Arg2 + 1, "E").Value
desc = Sheet1.Cells(Arg2 + 1, "B").Value
End If

If Arg1 = 2 Then
score = Sheet2.Cells(Arg2 + 1, "E").Value
desc = Sheet2.Cells(Arg2 + 1, "B").Value
End If

在散点图中找到特定点的参考行号

3 个答案: