我有一本工作簿和以下表格 仪表板,IImpactchart。
仪表板,具有候选名称,影响参考和影响参考
其值为
候选人1,影响值= 3,影响力值= 2
候选2,影响值= 3,影响值= 2
在图表中,我们需要在(3,2)的坐标中显示相应的行号。它只为单个候选人绘图。如果我们有更多具有相同值的候选者,则数据点重叠在一起。我们怎样才能改变用逗号分隔的数据点?或任何其他方式。
附图 Please click here to see the Chart output
需要图表 Please click here to see the required chart
使用VBA
Dim Counter As Integer, ChartName As String, xVals As String
Application.ScreenUpdating = False
Dim c As ChartObject
Set c = Sheets("IImpactchart").ChartObjects("Chart 1")
c.Activate
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
For Counter = 1 To Range(xVals).Cells.Count
If (Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = 0) Then
Exit Sub
End If
ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
True
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = Counter + 5
Next Counter
(计数器将增加5以获得正确的行号) - 其工作
现在我需要解决重叠问题。
帮助赞赏.. 感谢
答案 0 :(得分:0)
假设您当前的代码有效且唯一的问题是重叠,下面的代码可以解决您的问题。
此解决方案涉及使用名为LabelArray
的数组,该数组存储占据网格上点的第一个点的点编号。然后,不是为新点创建新标签,而是添加到第一个点的现有标签。
Sub LabelsNoOverlap()
Dim Counter As Integer, ChartName As String, xVals As String, yVals As String
Application.ScreenUpdating = False
Dim c As ChartObject
Set c = Sheets("IImpactchart").ChartObjects("Chart 2")
c.Activate
'Find address of the X values
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
'Not sure why this loop from your code is useful, but let's leave it.
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
'Find address of the Y values
yVals = ActiveChart.SeriesCollection(1).Formula
yVals = Mid(yVals, InStr(InStr(yVals, ","), yVals, _
Mid(Left(yVals, InStr(yVals, "!") - 1), 9)))
yVals = Right(yVals, Len(yVals) - InStr(yVals, ","))
yVals = Left(yVals, InStr(InStr(yVals, "!"), yVals, ",") - 1)
'Again, not sure why this loop from your code is useful, but let's leave it.
Do While Left(yVals, 1) = ","
yVals = Mid(yVals, 2)
Loop
Dim DimY As Long, DimX As Long
DimY = 10
DimX = 10
Dim LabelArray() As Long
ReDim LabelArray(1 To DimX, 1 To DimY)
Dim src As Series, pts As Points
Set src = ActiveChart.SeriesCollection(1)
Set pts = src.Points
'Clear labels
src.HasDataLabels = False
For Counter = 1 To Range(xVals).Cells.Count
If (Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = 0) Then
Exit Sub
End If
Dim xCoord As Long, yCoord As Long
xCoord = Range(xVals).Cells(Counter, 1).Value2
yCoord = Range(yVals).Cells(Counter, 1).Value2
If LabelArray(xCoord, yCoord) = 0 Then 'No overlap
LabelArray(xCoord, yCoord) = Counter
pts(Counter).HasDataLabel = True
pts(Counter).DataLabel.Text = Counter + 5
Else 'Overlap
pts(LabelArray(xCoord, yCoord)).DataLabel.Text = _
pts(LabelArray(xCoord, yCoord)).DataLabel.Text & "," & Counter + 5
End If
Next Counter
Application.ScreenUpdating = True
End Sub
请注意,只要X和Y值的值介于1到10之间,代码就会起作用。您还可以通过更改DimX
和DimY
的值来更改上限
此外,我应该提到这段代码有局限性:
src.XValues
和src.Values
(对于Y值)实现某些内容,它返回数组而不是范围。< / LI>