求助：修复VBA生成Excel垂直堆叠柱状图的脚本故障

需求回顾 #

• 数据结构：4列宽、行数可变，已用drlr存储最后一行行号
• 图表要求：
  • 第一列（对应变量p的列）作为X轴水平标签，每行对应一个独立柱形
  • 系列名称为各数据列的标题行，数据范围为第501行到drlr行的第2-4列（对应j、k、l列）
  • 每列对应固定颜色，图例展示系列与颜色的对应关系
  • 为每个工程师生成独立图表，图表格式统一

原代码核心问题 #

1. 系列添加逻辑错误：按行循环添加系列，导致每行生成一个系列，不符合堆叠柱状图的结构（堆叠图需每个数据列对应一个系列，同一行的多系列值堆叠成一个柱形）
2. X轴标签未配置：完全未设置分类轴标签，导致图表无X轴分类
3. 数据范围错误：取单行单元格作为系列值，而非整列连续数据
4. 颜色分配逻辑混乱：用行号取模分配颜色，导致颜色对应关系错误
5. 重复设置数据标签：冗余操作，影响效率

修复后的完整代码 #

Sub CreateStackedBarChart()
    Dim wsLookup As Worksheet
    Dim wsAvail As Worksheet
    Dim engRange As Range
    Dim engCell As Range
    Dim chartObj As ChartObject
    Dim chartTitle As String
    Dim seriesColors As Variant
    Dim p As Long, j As Long, k As Long, l As Long, drlr As Long
    Dim lastChartTop As Long
    Dim seriesIdx As Long ' 系列索引，用于匹配固定颜色
    
    ' 绑定目标工作表
    Set wsAvail = ThisWorkbook.Worksheets("Availability")
    Set wsLookup = ThisWorkbook.Worksheets("Lookup")
    
    ' 工程师名称范围
    Set engRange = wsLookup.Range("C6:C36")
    
    ' 初始列索引：p=X轴标签列，j/k/l=三个数据列
    p = 18
    j = 19
    k = 20
    l = 21
    
    ' 预定义系列颜色，与三个数据列一一对应
    seriesColors = Array(RGB(0, 59, 92), RGB(0, 174, 214), RGB(0, 230, 210))
    
    ' 第一个图表的顶部位置
    lastChartTop = 100
    
    ' 遍历每个工程师
    For Each engCell In engRange
        ' 跳过空单元格，避免生成无效图表
        If engCell.Value <> "" Then
            chartTitle = engCell.Value
            
            ' 获取当前工程师数据的最后一行
            drlr = wsLookup.Cells(wsLookup.Rows.Count, p).End(xlUp).Row
            ' 若数据起始行501超过最后一行，直接跳过
            If drlr < 501 Then GoTo NextEngineer
            
            ' 创建新图表对象
            Set chartObj = wsAvail.ChartObjects.Add(Left:=100, Width:=1000, Top:=lastChartTop, Height:=700)
            With chartObj.Chart
                ' 设置图表类型为垂直堆叠柱状图
                .ChartType = xlColumnStacked
                
                ' 设置图表标题
                .HasTitle = True
                .ChartTitle.Text = chartTitle
                
                ' 设置X轴分类标签（第一列的501到drlr行）
                .Axes(xlCategory).CategoryNames = wsLookup.Range(wsLookup.Cells(501, p), wsLookup.Cells(drlr, p)).Value
                
                ' 逐个添加数据系列
                seriesIdx = 0
                ' 系列1：j列
                With .SeriesCollection.NewSeries
                    .Name = wsLookup.Cells(500, j).Value ' 标题行取500行（数据从501开始）
                    .Values = wsLookup.Range(wsLookup.Cells(501, j), wsLookup.Cells(drlr, j)).Value
                    .Format.Fill.ForeColor.RGB = seriesColors(seriesIdx)
                    .ApplyDataLabels ' 显示数据标签
                End With
                seriesIdx = seriesIdx + 1
                
                ' 系列2：k列
                With .SeriesCollection.NewSeries
                    .Name = wsLookup.Cells(500, k).Value
                    .Values = wsLookup.Range(wsLookup.Cells(501, k), wsLookup.Cells(drlr, k)).Value
                    .Format.Fill.ForeColor.RGB = seriesColors(seriesIdx)
                    .ApplyDataLabels
                End With
                seriesIdx = seriesIdx + 1
                
                ' 系列3：l列
                With .SeriesCollection.NewSeries
                    .Name = wsLookup.Cells(500, l).Value
                    .Values = wsLookup.Range(wsLookup.Cells(501, l), wsLookup.Cells(drlr, l)).Value
                    .Format.Fill.ForeColor.RGB = seriesColors(seriesIdx)
                    .ApplyDataLabels
                End With
                
                ' 统一图表格式
                .Legend.Position = xlLegendPositionRight
                .Axes(xlValue).MajorGridlines.Visible = True
                .ChartArea.Format.Fill.ForeColor.RGB = RGB(255, 255, 255)
            End With
            
            ' 更新下一个图表的顶部位置
            lastChartTop = lastChartTop + 800
        End If
        
NextEngineer:
        ' 列索引递增，切换到下一个工程师的4列数据
        p = p + 4
        j = j + 4
        k = k + 4
        l = l + 4
    Next engCell
End Sub

关键修改说明 #

• 修正系列添加逻辑：按数据列添加系列，确保同一行的三个系列值堆叠成一个柱形
• 添加X轴标签配置：通过Axes(xlCategory).CategoryNames绑定第一列内容为水平标签
• 固定颜色对应关系：用seriesIdx索引匹配预定义颜色数组，保证每个数据列颜色固定且与图例一致
• 修正数据范围：每个系列取对应列从501到drlr的完整数据
• 增加空值判断：跳过空的工程师名称单元格，避免无效图表
• 统一格式设置：规范图例位置、网格线、背景色等，确保所有图表样式一致

内容的提问来源于stack exchange，提问作者VB eh....