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