VBA生成XY散点爆破装药图时34号钻孔数据标签缺失问题咨询

问题原因 #

代码存在的核心问题如下：

• 钻孔范围设置不合理：HoleList 写死为Range("B14:B4500")，远大于实际345个钻孔的行数，若C/D列对应第34个钻孔的行存在空值，该点不会被计入系列的Points集合，标签赋值时会出现错位，恰好跳过34号的标签。
• 数据源操作冗余：先用SetSourceData绑定了C/D列坐标，后续又额外重复添加一次Range("C14:D4500")作为系列，容易引发系列索引混乱，导致标签绑定到错误系列。
• 概率较高的触发原因：34号钻孔的XY坐标和其他钻孔完全重合，上层点的标签盖住了34号的标签；或是34号点位刚好落在坐标轴刻度范围的边界，点位正常显示但标签被裁剪。

修复后的代码 #

Sub Create_Charge_Map()
    Dim ochartObj As ChartObject
    Dim oChart As Chart
    Dim HoleDataSeries As Series
    Dim SingleCell As Range
    Dim HoleList As Range
    Dim HoleCounter As Integer
    Dim FontSize As Integer
    Dim ws As Worksheet
    
    ' 直接绑定工作表，避免依赖Select操作引发的范围错误
    Set ws = Worksheets("Charge_Map")
    HoleCounter = 1
    FontSize = ws.Range("AG2").Value
    ' 自动识别B列实际有孔号的行数，避免写死范围
    Set HoleList = ws.Range("B14:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
    
    ' 创建图表
    Set ochartObj = ws.ChartObjects.Add(Top:=10, Left:=325, Width:=600, Height:=300)
    Set oChart = ochartObj.Chart
    oChart.ChartType = xlXYScatter
    
    ' 设置数据源，删除冗余的重复添加C/D列操作
    oChart.SetSourceData Source:=ws.Range("C14:D" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
    oChart.SeriesCollection.Add Source:=ws.Range("J14:J4500")
    oChart.SeriesCollection.Add Source:=ws.Range("M14:M4500")
    oChart.SeriesCollection.Add Source:=ws.Range("P14:P4500")
    oChart.SeriesCollection.Add Source:=ws.Range("S14:S4500")
    oChart.SeriesCollection.Add Source:=ws.Range("V14:V4500")
    oChart.SeriesCollection.Add Source:=ws.Range("Y14:Y4500")
    
    ' 设置坐标轴刻度，取消Select操作提升稳定性
    With oChart.Axes(xlValue)
        .MinimumScale = ws.Range("T8").Value
        .MaximumScale = ws.Range("T9").Value
    End With
    With oChart.Axes(xlCategory)
        .MinimumScale = ws.Range("S8").Value
        .MaximumScale = ws.Range("S9").Value
    End With
    
    ' 绑定钻孔坐标系列添加标签
    Set HoleDataSeries = oChart.SeriesCollection(1)
    oChart.SetElement msoElementDataLabelNone
    HoleDataSeries.HasDataLabels = True
    
    ' 按实际点位数量循环，避免索引越界错位
    For HoleCounter = 1 To HoleDataSeries.Points.Count
        HoleDataSeries.Points(HoleCounter).DataLabel.Text = HoleList.Cells(HoleCounter, 1).Value
    Next HoleCounter
    
    ' 设置标签样式
    With HoleDataSeries.DataLabels
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlLTR
        .Position = xlLabelPositionCenter
        .Orientation = xlHorizontal
        .Font.Size = FontSize
        .Font.Bold = True
    End With
End Sub

额外排查步骤 #

如果修改代码后34号标签仍然缺失，可做以下检查：

• 查看34号钻孔对应的C/D列坐标是否为空值，或者和S8/S9/T8/T9的刻度值完全一致，被坐标轴边缘裁剪
• 检查34号钻孔的坐标是否和其他钻孔完全重合，可临时把标签位置改为xlLabelPositionAbove，确认是否有重叠标签
• 查看B列34号孔的单元格是否存在不可见字符、空格或者空值

内容的提问来源于stack exchange，提问作者William Lee