使用VBA从图表中删除数据点
这个问题是参考使用VBA从图表中删除数据点。
经过广泛的search，我遇到了一些非常有用的代码。 特别是Jon Peltier（获取有关embedded图表中某一点的信息）：
不幸的是，这个代码只返回数据点的序列名称和值（非常有用，但需要更进一步）。 为了使这个代码更健壮一些，理想情况下，它将返回所选数据点的单元格位置（可以突出显示，删除等）。 前段时间另一个论坛也提出了完全相同的问题，但没有解决scheme（请参阅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
（注意：我不确定你的图表是如何设置的，所以返回的范围可能会有所不同）。
要返回图表上的select范围，可以执行以下操作：
Set seriesParts = Split(.SeriesCollection(a).Formula) Set ySeriesAddress = seriesParts(2) set ySeriesRange = Range(ySeriesAddress)
从这里开始，根据您拥有的图表types，可以使用GetChartElement方法的arg1和arg2值来select包含要删除的数据的单元格。
例如，如果你有一个简单的图表和下面的数据
并select的点是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”
pipe理得到一些代码runinng而不使用set函数。 见下文：
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