☰

图表宏在筛选工作表上显示非连续可见行中的错误标签

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba macros charts
图表宏在筛选工作表上显示非连续可见行中的错误标签

双击散点图上的某个点时，此宏将显示源工作表中的文本标签。当源工作表按任意几列进行筛选时，图表会更新。该宏应该会检测到这种筛选，并相应地更新标签值。

当数据在已筛选列上排序时，此方法有效，但当数据在未排序的其他列上也排序时，此方法无效，这会导致出现额外的隐藏行。

问题是，尽管有些行是隐藏的，但宏会从第一个可见行开始计算可见行和隐藏行（好像xlCellTypeVisible不起作用）。

澄清一下：只要过滤子集中没有隐藏行，标签就会从过滤子集上的第一个可见行开始正确显示。但是，当对未按过滤值排序的列应用附加过滤器时，由于除了可见行之外还计算了散布的隐藏行，标签会变得混乱。

详细信息： - 起始行正确计算为第一个可见行。 - Arg2 值也正确设置为适当的可见的系列中的行，并且即使在未排序的行上进行过滤，标签上的 xData 和 yData 值也是正确的！（因此 Arg2 会跳过任何隐藏的行，与图表上显示的系列一致。）

但其他列的标签不正确。

基本上，我需要从行号 Arg2 的范围中获取我的标签文本可见的已筛选工作表上的行。

我猜问题出在sid = .cells计数使用所有行而不是仅使用可见行的部分。同样，实际计数（使用 Msgbox 显示时）确实指向正确的可见的如果我直观地倒数源工作表上的行数，则会出现行。但标签中的实际文本是基于将此计数应用于隐藏行和可见行，因此会出现数据中较高的错误行。

我尝试过改为sid = .cells，sid = r.cells但没有成功，事实上它从数据的第一行开始计数，而不是第一个可见行。看起来SpecialCells(xlCellTypeVisible)只有在识别第一的可见的行，但对任何后续的隐藏行感到困惑。

任何帮助都将不胜感激。我是 VBA 新手，所以请说清楚/具体！

Public WithEvents myChartClass As Chart

Private Sub myChartClass_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
Dim ser As Series
Dim pt As Point
Dim xData As Double, yData As Double
Dim sid As String

'declare vars used for calculating row number for filtered data
Dim r As Range
Dim StartRow As Long

Cancel = True
For Each ser In Me.SeriesCollection
    ser.HasDataLabels = False
Next

If ElementID = xlSeries Then
    If Arg2 > 0 Then
        With Worksheets("MySheetName")
            Set ser = Me.SeriesCollection(Arg1)
             xData = ser.XValues(Arg2)
             yData = ser.Values(Arg2)
            Set pt = ser.Points(Arg2)

'calculate starting row when table is filtered on any variable
Set r = Worksheets("MySheetName").Range("A:A").Rows.SpecialCells(xlCellTypeVisible)
StartRow = r.Row - 1 'starting row is the first visible row minus the table header

            'grab label from the row associated with the clicked point on chart
            'the case number signifies the series of the chart in the order visible in Select Data chart properties window
            Select Case Arg1
            Case 1  'series 1
                sid = .Cells(Arg2 + StartRow, "D") & vbLf & "label1: " & .Cells(Arg2 + StartRow, "C") & vbLf & "label2: " & .Cells(Arg2 + StartRow, "L") & vbLf & "label3: " & .Cells(Arg2 + StartRow, "U")
            Case 2  'series 2
                sid = .Cells(Arg2 + StartRow, "D") & vbLf & "label1: " & .Cells(Arg2 + StartRow, "C") & vbLf & "label2: " & .Cells(Arg2 + StartRow, "L") & vbLf & "label3: " & .Cells(Arg2 + StartRow, "U")
            End Select

            pt.HasDataLabel = True
            pt.DataLabel.Characters.Font.Size = 11
            pt.DataLabel.Characters.Font.Bold = True
            pt.DataLabel.Text = sid & vbLf & "(" & xData & " , " & yData & ")"

    'MsgBox "r: " & r.Count
    'MsgBox "StartRow: " & StartRow
    'MsgBox "Arg1: " & Arg1
    'MsgBox "Arg2: " & Arg2

        End With
    End If
End If
End Sub

答案1

您的诊断是正确的——使用 解析单元格引用时，VBA 会忽略隐藏/未隐藏状态.Cells。我发现，只有强力单元格计数方法才有效：

Dim iter As Long, findCount As Long, workCel as Range

' This is okay as long as you are guaranteed only to have one header row.
Set workCel = Worksheets("MySheetName").Cells(2, 1)

' No cells found yet
findCount = 0

' Start iterator at zero
iter = 0

Do  
    ' Check row for hidden status
    If Not workCel.Offset(iter, 0).EntireRow.Hidden Then
        ' Row is visible; increment number of visible rows found
        findCount = findCount + 1
    End If

    ' Increment iterator
    iter = iter + 1

' Stop looping once the number of found rows reaches the desired count
Loop Until findCount >= Arg2

所需的索引应从上述代码中得出，其值为iter：

sid = .Cells(iter + StartRow, "D") & vbLf & ...

不需要后减，因为.Offset(n, 0)指的是从给定单元格开始的范围的第行n+1。

要注意，该.SpecialCells(xlCellTypeVisible)函数可能工作正常。问题是，由于Range被各种隐藏行“中断”，它由多个Areas（参见此处：http://msdn.microsoft.com/en-us/library/office/ff196243(v=office.15).aspx）。这完全破坏了正常.Cells(...)类型的索引。它从第一行数据开始，因为您的标题行是未隐藏的，因此固定了您的r范围。

答案2

@Brian，再次感谢——您的回答和参考使Areas我研究了获取与系列中的 Arg2 值相对应的可见行数的方法。

做了一些研究，发现了一个原则上看似类似的解决方案，但是计算行而不是单元格（http://www.ozgrid.com/forum/showthread.php?t=23611）。这似乎有效：

Public WithEvents myChartClass As Chart

Private Sub myChartClass_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
Dim ser As Series
Dim pt As Point
Dim xData As Double, yData As Double
Dim sid As String

'declare vars used for calculating row number for filtered data
Dim rng As Range, rngArea As Range, lRows As Long, lRow2 As Long

Cancel = True
For Each ser In Me.SeriesCollection
    ser.HasDataLabels = False
Next

If ElementID = xlSeries Then
    If Arg2 > 0 Then
        With Worksheets("MySheetName")
            Set ser = Me.SeriesCollection(Arg1)
             xData = ser.XValues(Arg2)
             yData = ser.Values(Arg2)
            Set pt = ser.Points(Arg2)

'check autofilter;
    If Not .AutoFilterMode Then
        MsgBox "Please enable autofilter on source worksheet."
        Exit Sub
    End If

'set a range = to visible cells (excluding the header)
Set rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)

'calculate starting row when table is filtered on any variable;
'loop through areas until row is found;
    lRows = 0
    For Each rngArea In rng.Areas
        lRows = lRows + rngArea.Rows.Count
        If lRows >= Arg2 Then
            lRow2 = rngArea.Item(Arg2 - (lRows - rngArea.Rows.Count)).Row
            Exit For
        End If
    Next rngArea

            'grab label from the row associated with the clicked point on chart
            'the case number signifies the series of the chart in the order visible in Select Data chart properties window
            Select Case Arg1
            Case 1  'series 1
            sid = .Cells(lRow2, "D") & vbLf & "label1: " & .Cells(lRow2, "C") & vbLf & "label2: " & .Cells(lRow2, "L") & vbLf & "label3: " & .Cells(lRow2, "U")
            Case 2  'series 2
            sid = .Cells(lRow2, "D") & vbLf & "label1: " & .Cells(lRow2, "C") & vbLf & "label2: " & .Cells(lRow2, "L") & vbLf & "label3: " & .Cells(lRow2, "U")
            End Select

            pt.HasDataLabel = True
            pt.DataLabel.Characters.Font.Size = 11
            pt.DataLabel.Characters.Font.Bold = True
            pt.DataLabel.Text = sid & vbLf & "(" & xData & " , " & yData & ")"


    'MsgBox "lRow2: " & lRow2

        End With
    End If
End If
End Sub

相关内容