Fatal编程技术网
  • excel/
  • Excel 在散点图中查找特定点的参考行号

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

excel vba

Excel 在散点图中查找特定点的参考行号,excel,vba,Excel,Vba,目标：我想从两张单独的纸上散点绘制的过滤序列中找到数据点的参考行数 我遵循这些指南，但收效甚微： 场景：我有两张表格，其中包含相同表格格式的数据： +-----+-------------+---------+---------+-------+ | Row | Description | X-value | Y-value | Score | +-----+-------------+---------+---------+-------+ | 1 | "Something" |

目标：我想从两张单独的纸上散点绘制的过滤序列中找到数据点的参考行数

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

  • 场景：我有两张表格，其中包含相同表格格式的数据：

    +-----+-------------+---------+---------+-------+
| 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-val和y-val已散点绘制为同一图表上的单独系列

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

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

    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
    我希望我能在Tim Williams和Display Name之间分配奖金。由于我只能选择一个，因此奖励将授予Tim。

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

    因此，替换为：

    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
    与：

    您可以这样做：

    '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
    使用Arg1和Arg2从事件类调用
    ”
子HandlePointClicked（seriesNum尽可能长，pointNum尽可能长）
Dim vis作为范围，c作为范围，i作为长度，rowNum作为长度
将sht变暗为工作表
'哪个工作表包含源数据？
Set sht=GetSheetFromSeriesNumber（seriesMum）
'仅获取源数据表上可见的行
（根据您的具体情况进行调整…）
设置可视范围=短范围（“A2:A100”）。特殊单元格（xlCellTypeVisible）
“您不能直接索引到vis
“例如，vis.Cells（pointNum）可能无法像您预期的那样工作
所以你必须做一些像这样的循环
对于每一个可见细胞中的c
i=i+1
如果i=pointNum，则rowNum=c.行
下一个c

    Debug.Print rowNum'作为对我先前尝试回答而不深入您问题细节的弥补，并且为了防止专家查看我删除的答案，我提供了另一种解决方案。但在讨论代码和所有内容之前，我必须承认@Tim Williams已经提供了最佳解决方案，并且认为只有他的答案值得接受（截止日期）。我找不到其他不循环获取行号的选项
    
我只是尝试将这些片段组合起来，并与您的代码集成。我有以下自由
    

  • 在修改/使用图表时，将类模块用作直接编码
    图表\u 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

    

    子初始化chart（）&ReleaseChart（）
    可分配给工作表上图表附近的按钮。请适当修改工作表名称、地址、图表名称、文本框名称等。它正在处理临时筛选的数据
    

    

    希望它会有用
    当过滤中的行不连续时，您的答案也有效吗？这只适用于匹配x值，在隐藏行时效果不佳。对于隐藏行，我必须在.End（xlUp））之后包含.SpecialCells（xlCellTypeVisible）和If.Offset（，1）.Value=chart_数据（Arg2），然后在分配score和desc以检查y值之前包含语句。在某些鼠标悬停事件中，找不到分数和描述-可能是由于所选Sheet1.Name或Sheet2.Name处于活动状态？它也适用于非连续范围。我假设x值是唯一的。不需要特殊的电池。我的代码没有使任何工作表处于活动状态。您可能还想添加一些“If ElementID=xlSeries Then”复选框，以便仅在悬停序列时执行操作是的，我将用我的其余代码更新我的问题。在匹配x和y值时似乎存在复杂性，这会使您的解决方案无法工作。似乎您的代码已经全部停止工作，您是否必须实例化子语句中的任何内容才能使With语句工作？似乎score和desc现在返回空和“”。有点不明白为什么，所有的改变都是在Windows和osx中打开工作簿。

    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
        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 With
End With

    

    '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

    

    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