使用VBA从图表中删除数据点

使用VBA从图表中删除数据点,vba,excel,Vba,Excel,此问题在使用VBA从图表中删除数据点的参考中 经过广泛的搜索,我发现了一些非常有用的代码。特别是来自Jon Peltier(获取嵌入式图表中某个点的信息): 不幸的是,这段代码只返回数据点的序列名和值(非常有用,但需要更进一步)。为了使这段代码更加健壮,理想情况下,它将返回所选数据点的单元格位置(在该位置上可以高亮显示、删除等)。不久前在另一个论坛上提出了完全相同的问题,但没有解决方案(见ozgrid的链接,下面的链接) 本质上,我需要从序列名和数据点提取单元格地址,这样我就可以编写一段代码来清

此问题在使用VBA从图表中删除数据点的参考中

经过广泛的搜索,我发现了一些非常有用的代码。特别是来自Jon Peltier(获取嵌入式图表中某个点的信息):

不幸的是,这段代码只返回数据点的序列名和值(非常有用,但需要更进一步)。为了使这段代码更加健壮,理想情况下,它将返回所选数据点的单元格位置(在该位置上可以高亮显示、删除等)。不久前在另一个论坛上提出了完全相同的问题,但没有解决方案(见ozgrid的链接,下面的链接)

本质上,我需要从序列名和数据点提取单元格地址,这样我就可以编写一段代码来清除单元格的内容,从而从图表中删除数据点。有什么想法吗?i、 e.要更新的代码部分:

'Sheet4.Cells(b, ????).ClearContents
谢谢你的意见

这一问题也被问到:

**

(链接至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 
(注意:我不确定您的图表是如何设置的,因此返回的范围可能会有所不同)。

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

Set seriesParts = Split(.SeriesCollection(a).Formula)
Set ySeriesAddress = seriesParts(2)
set ySeriesRange = Range(ySeriesAddress)
在此,根据您拥有的图表类型,您可以使用
GetChartElement
方法的
arg1
arg2
值来选择包含要删除的数据的单元格

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

选择的点是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”

以便在不使用
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

您使用的是什么类型的图表?一个简单的散点图,只有一个数据系列(请参阅下面的更多注释)