2

这个问题是参考使用 VBA 从图表中删除数据点。

经过广泛的搜索，我遇到了一些非常有用的代码。特别是来自 Jon Peltier (Get Information about a point in an embedded chart)：

不幸的是，此代码仅返回数据点的系列名称和值（非常有用，但需要更进一步）。为了使这段代码更健壮一点，理想情况下它会返回所选数据点的单元格位置（在该位置上可以突出显示、删除等）。前段时间在另一个论坛上提出了完全相同的问题，但没有解决方案（请参阅 ozgrid 的链接，下面的链接）

本质上，我需要从系列名称和数据点中提取单元格地址，这样我就可以编写一段代码来清除单元格的内容，从而从图表中删除数据点。有任何想法吗？即要更新的代码部分：

'Sheet4.Cells(b, ????).ClearContents

感谢您的任何意见！

这个问题也被问到：

http://www.ozgrid.com/forum/showthread.php?t=181251&goto=newpost **

（带有指向 Jon Pelteir 和其他参考资料的链接）

完整的代码是：

Private Sub EvtChart_MouseUp(ByVal Button As Long, ByVal Shift As Long, _ 
ByVal x As Long, ByVal y As Long) 
 'extracted and modified from [URL]http://www.computorcompanion.com/LPMArticle.asp?ID=221[/URL]

Dim ElementID As Long 
Dim a As Long 
Dim b As Long 
Dim msg As String 
Dim myX As Date 
Dim myY As Double 
Dim Answer As Integer 
Dim Counter As Integer 
Dim QAFDest As Range 
Dim NoRows As Integer 
With ActiveChart 
     ' Pass x & y, return ElementID and Args
    .GetChartElement x, y, ElementID, a, b 
    If ElementID = xlSeries Then 
        If b > 0 Then 
             ' Extract x value from array of x values
            myX = WorksheetFunction.Index _ 
            (.SeriesCollection(a).XValues, b) 
             ' Extract y value from array of y values
            myY = WorksheetFunction.Index _ 
            (.SeriesCollection(a).Values, b) 

             ' Display message box with point information
            msg = "You are about to remove the following point from data Series " & vbCrLf _ 
            & """" & .SeriesCollection(a).Name & """" & vbCrLf _ 
            & "Point " & b & vbCrLf _ 
            & "Value = " & myY & vbCrLf _ 
            & "Continue?" 
            If MsgBox(msg, vbOKCancel) = vbOK Then 
                 'Sheet4.Cells(b, ????).ClearContents
            End If 
        End If 
    End If 
End With 
End Sub
4

2 回答 2

1

（注意：我不确定您的图表是如何设置的，因此返回的范围可能会有所不同）。

要返回图表上给定选择的范围，您可以执行以下操作：

Set seriesParts = Split(.SeriesCollection(a).Formula)
Set ySeriesAddress = seriesParts(2)
set ySeriesRange = Range(ySeriesAddress)

从这里，根据您拥有的图表类型，您可以使用方法arg1的arg2值GetChartElement来选择包含要删除的数据的单元格。

例如，如果您有一个简单的图表和数据，如下所示

示例图表数据

并且选择的点是点 C（索引为 3），您将使用以下代码

Set seriesParts = Split(.SeriesCollection(a).Formula)
Set ySeriesAddress = seriesParts(2)
' The code below would return the range "B2:B9
set ySeriesRange = Range(ySeriesAddress)
ySeriesRange(b).ClearContents

这将从图表数据中清除值“3”

于 2013-07-29T22:14:33.070 回答
0

Managed to get a some code runinng without using the set function. See below:

Private Sub EmbChart_MouseUp _
(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Double, myY As Double

Dim SF As String
Dim splitArray() As String

Dim row As Long
Dim column As String

If Button = xlPrimaryButton Then
With EmbChart
'Pass x & y, return ElementID and Args
    .GetChartElement X, Y, ElementID, Arg1, Arg2

    Application.StatusBar = "[" & ElementID & "]" 'delete?

    If ElementID = xlSeries Or ElementID = xlDataLabel Then
        If Arg2 > 0 Then
                ' Extract x value from array of x values
            myX = WorksheetFunction.Index(.SeriesCollection(Arg1).XValues, Arg2)
                ' Extract y value from array of y values
            myY = WorksheetFunction.Index(.SeriesCollection(Arg1).Values, Arg2)

            Application.StatusBar = "[" & myX & ", " & myY & "]"

                  'find row of selected chart point
                   row = myX + 3                            'dependant on starting row of data


                  'find row of selected chart point
                   SF = .SeriesCollection(Arg1).Formula     'return series formula as string
                   splitArray() = Split(SF, "$")            'split series formula into array with $ as deliminter
                   column = splitArray(3)                   'return selected column


                   Debug.Print column


                   'delete and highlight corresponding cell

                ActiveSheet.Cells(row, column).ClearContents
                ActiveSheet.Cells(row, column).Interior.Color = vbYellow

       End If

    End If

Application.StatusBar = False


End With
End If
End Sub
于 2013-07-30T14:50:37.163 回答