VBA生成图表横轴刻度调整求助：日期轴显示异常（月天数不同）

嘿，我看你在VBA生成图表时遇到了X轴日期显示的问题——本来只想展示12.19、01.20、02.20这类月份标签，结果因为不同月份天数不一样，用固定31天的刻度单位导致显示异常。这问题我碰到过，给你两个靠谱的解决思路，按需选：

你的X轴是离散的月份标签，XY散点图是连续数值轴，天生不适合这类离散分类场景。改用折线图（分类轴）可以直接用你想要的月份文本作为X轴标签，彻底避开天数差异的问题：

修改代码里的图表类型及X轴处理逻辑：

' 替换原Charts.Add及后续的With ActiveChart块
Charts.Add
With ActiveChart
    .ChartArea.ClearContents
    .ChartType = xlLine ' 改用折线图（分类轴模式）
    .ChartStyle = 241
    
    ' 先把日期数组转换成你需要的"mm.yy"格式文本标签
    Dim xLabels() As String
    ReDim xLabels(numeelem - 1)
    For j = 0 To numeelem - 1
        xLabels(j) = Format(listax(j), "mm.yy")
    Next j
    
    For k = 1 To 2
        For j = 0 To numeelem - 1
            ydata(j) = listay(j, k - 1)
        Next j
        .SeriesCollection.NewSeries
        .SeriesCollection(k).XValues = xLabels ' 直接绑定文本标签
        .SeriesCollection(k).Values = ydata
        .SeriesCollection(k).Name = Worksheets("Data").Cells(1, 5 + k).Value ' 对应原数据第6、7列的表头
        If k = 2 Then
            .SeriesCollection(k).Format.Line.DashStyle = msoLineSysDash
        End If
        ' 保留数据标签逻辑
        For j = 1 To numeelem
            With .SeriesCollection(k).Points(j)
                .ApplyDataLabels
                .DataLabel.Text = listay(j - 1, k - 1)
            End With
        Next j
    Next k
    
    ' 保留标题、图例设置
    .HasTitle = True
    .Legend.Format.TextFrame2.TextRange.Font.Size = 14
    .ChartTitle.Text = contrato & " - " & kpi
    
    ' 调整X轴（分类轴无需时间刻度参数）
    With .Axes(xlCategory, xlPrimary)
        .HasTitle = True
        .AxisTitle.Characters.Text = "Date"
        .AxisTitle.Font.Size = 14
        .AxisTitle.Font.Name = "Calibri"
        .TickLabels.NumberFormat = "mm.yy"
        .TickLabels.Font.Size = 12
    End With
    
    ' Y轴设置保留
    With .Axes(xlValue, xlPrimary)
        .HasTitle = True
        .AxisTitle.Text = "Amount of €"
        .AxisTitle.Font.Size = 14
        .AxisTitle.Font.Name = "Calibri"
    End With
End With

如果必须用散点图（比如需要展示日期的连续性），那得把数据点的X轴日期统一为当月第一天，再动态计算每月的天数作为刻度单位：

1. 先修改listax的赋值逻辑，把日期转为当月第一天：

' 替换原listax赋值行
listax(numeelem - 1) = DateSerial(Year(Worksheets("Data").Cells(i, 8).Value), _
                                 Month(Worksheets("Data").Cells(i, 8).Value), 1)

2. 然后调整X轴刻度设置，动态计算每月天数：

With .Axes(xlCategory, xlPrimary)
    .HasTitle = True
    .AxisTitle.Characters.Text = "Date"
    .AxisTitle.Font.Size = 14
    .AxisTitle.Font.Name = "Calibri"
    .CategoryType = xlTimeScale
    .MinimumScale = listax(0)
    .MaximumScale = DateAdd("m", 1, listax(numeelem - 1)) - 1 ' 设为当月最后一天
    .MajorUnit = Day(DateSerial(Year(listax(0)), Month(listax(0)) + 1, 0)) ' 动态取当月天数
    .TickLabels.NumberFormat = "mm.yy"
End With

原代码里两次遍历Data工作表的行，可以合并成一次，既减少耗时又避免重复逻辑：在第一次循环时就同时计数并填充listax和listay，不用先单独计数再重新遍历。另外记得把last_row声明为Long类型（行数可能超过Integer的上限）。

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