数据标签没有以正确的顺序显示,使用vba excel散乱图表

时间:2018-02-08 14:07:09

标签: excel excel-vba vba

我有一张包含主数据的Excel工作表,其中包含以下信息

行号|候选人| X值| Y值

我需要绘制一个分散的图表,其中X和Y值用行号作为数据标签。创建了一个VBA来实现这一点,它起作用但是datalabel重叠了。它是在我们的一位成员的帮助下修复的。但现在的问题是,一些数据点显示在不同的点上。

Error picture here, please click

代码如下

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 1")
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 = 250
DimX = 250

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

1 个答案:

答案 0 :(得分:0)

通过更改

解决了上述问题
yCoord = Range(yVals).Cells(Counter, 1).Value2

yCoord = Range(yVals).Cells(Counter, 2).Value2