Цель: Я ищу, чтобы найти число контрольных рядов точек данных из отфильтрованных рядов, которые были разбросаны на двух отдельных листах.
Я следую этим руководствам с небольшим успехом:
- Цикл Excel VBA по видимым отфильтрованным строкам
- Excel vba - найти номер строки, где данные столбца (несколько предложений)
Сценарий: У меня есть два листа, содержащие данные в одинаковом табличном формате:
+-----+-------------+---------+---------+-------+
| 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, который при наведении курсора мыши на диаграмме возвращает индекс серии, координаты x и y конкретной точки данных (Arg1, ser.Values, ser.XValues):
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: Как заметил Тим Уильямс, нет способа обойти это без обхода диапазона. Я объединил его псевдокод с примером 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
Хотел бы я разделить награду между Тимом Уильямсом и отображаемым именем. Поскольку я могу выбрать только одну, награда достается Тиму.