VBA创建按月统计错误类型的堆叠条形图问题求解

• 个人基础：VBA初学者，编码经验较少，需要VBA实现图表生成的相关技术支持
• 数据结构：当前工作表C列存储M/DD/YYYY格式的问题发现日期，H列存储错误类型（包含人为、设备、材料、方法/流程、环境、未知几类）
• 目标效果：生成堆叠条形图，X轴为月份维度，Y轴为错误总数量，条形按错误类型分色，堆叠展示各类型的月度错误数量
• 现存卡点：
  • 原设想用For循环实现分月分类型计数，但不清楚具体语法和完整图表创建流程
  • 现有代码仅能统计全量维度的各错误类型总数量，无法实现按月拆分的分类型计数
  • 代码运行到设置C列、H列数据范围的步骤时，触发「下标越界」报错

• 下标越界报错直接原因：代码中引用的工作表名Macros Test Sheet和当前工作簿内实际工作表名称不匹配（常见原因是拼写错误、名称前后带多余空格、工作表被重命名/删除）
• 统计逻辑缺陷：仅对错误类型列做单维度计数，未关联日期列做月份维度的拆分统计
• 变量拼写错误：统计环境类错误时，变量名误写为EnvironementError，和之前声明的EnvironmentError变量名不一致，会导致环境类错误统计结果始终为0

下面的代码会自动识别有效数据范围，逐行遍历完成分月分类型的错误计数，基于统计结果直接生成符合要求的堆叠条形图，全程不需要手动做数据汇总：

Sub CreateStackedBarChart()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim errorType As String, monthLabel As String
    Dim auxStartCol As Long, monthRow As Long
    Dim chartObj As ChartObject
    Dim stackedChart As Chart
    
    ' --------------------------
    ' 可根据实际情况修改以下参数
    ' --------------------------
    Const SHEET_NAME As String = "Macros Test Sheet" ' 存放数据的工作表名，务必和实际表名完全一致
    Const DATE_COL As String = "C" ' 日期所在列
    Const CAUSE_COL As String = "H" ' 错误类型所在列
    Const START_ROW As Long = 2 ' 数据起始行（第1行默认为表头）
    auxStartCol = 10 ' 临时统计区域起始列，默认J列（第10列），如果该列有数据可修改为其他空白列号
    
    ' 校验工作表是否存在，避免下标越界
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "不存在名为【" & SHEET_NAME & "】的工作表，请检查代码里的表名配置！"
        Exit Sub
    End If
    
    ' 清理之前的临时统计数据和旧图表
    ws.Columns(auxStartCol).Resize(, 7).Clear
    For Each chartObj In ws.ChartObjects
        chartObj.Delete
    Next
    
    ' 写入临时统计表头
    ws.Cells(1, auxStartCol) = "月份"
    ws.Cells(1, auxStartCol + 1) = "Human"
    ws.Cells(1, auxStartCol + 2) = "Equipment"
    ws.Cells(1, auxStartCol + 3) = "Material"
    ws.Cells(1, auxStartCol + 4) = "Method/Procedure"
    ws.Cells(1, auxStartCol + 5) = "Environment"
    ws.Cells(1, auxStartCol + 6) = "Unknown"
    
    ' 获取C列最后一行有效数据行号
    lastRow = ws.Cells(ws.Rows.Count, DATE_COL).End(xlUp).Row
    
    ' 逐行遍历数据，统计分月分类型错误数
    For i = START_ROW To lastRow
        ' 跳过日期为空、错误类型为空的行
        If IsDate(ws.Cells(i, DATE_COL).Value) And Trim(ws.Cells(i, CAUSE_COL).Value) <> "" Then
            ' 生成月份标签，格式为"1月""2月"，如果需要带年份可改成Format(ws.Cells(i, DATE_COL).Value, "yyyy年m月")
            monthLabel = Month(ws.Cells(i, DATE_COL).Value) & "月"
            errorType = Trim(ws.Cells(i, CAUSE_COL).Value)
            
            ' 查找该月份是否已经在临时统计区存在
            monthRow = 0
            On Error Resume Next
            monthRow = WorksheetFunction.Match(monthLabel, ws.Columns(auxStartCol), 0)
            On Error GoTo 0
            
            ' 月份不存在则新增一行
            If monthRow = 0 Then
                monthRow = ws.Cells(ws.Rows.Count, auxStartCol).End(xlUp).Row + 1
                ws.Cells(monthRow, auxStartCol) = monthLabel
            End If
            
            ' 对应错误类型计数+1
            Select Case errorType
                Case "Human": ws.Cells(monthRow, auxStartCol + 1) = ws.Cells(monthRow, auxStartCol + 1) + 1
                Case "Equipment": ws.Cells(monthRow, auxStartCol + 2) = ws.Cells(monthRow, auxStartCol + 2) + 1
                Case "Material": ws.Cells(monthRow, auxStartCol + 3) = ws.Cells(monthRow, auxStartCol + 3) + 1
                Case "Method/Procedure": ws.Cells(monthRow, auxStartCol + 4) = ws.Cells(monthRow, auxStartCol + 4) + 1
                Case "Environment": ws.Cells(monthRow, auxStartCol + 5) = ws.Cells(monthRow, auxStartCol + 5) + 1
                Case "Unknown": ws.Cells(monthRow, auxStartCol + 6) = ws.Cells(monthRow, auxStartCol + 6) + 1
            End Select
        End If
    Next i
    
    ' 按月份升序排序统计结果
    ws.Range(ws.Cells(1, auxStartCol), ws.Cells(monthRow, auxStartCol + 6)).Sort _
        Key1:=ws.Cells(1, auxStartCol), Order1:=xlAscending, Header:=xlYes
    
    ' 创建堆叠条形图
    Set chartObj = ws.ChartObjects.Add(Left:=ws.Range("J10").Left, Width:=600, Top:=ws.Range("J10").Top, Height:=350)
    Set stackedChart = chartObj.Chart
    With stackedChart
        .ChartType = xlBarStacked ' 如果需要纵向堆叠柱形图（X轴月份在底部），把这里改成xlColumnStacked
        .SetSourceData Source:=ws.Range(ws.Cells(1, auxStartCol), ws.Cells(monthRow, auxStartCol + 6))
        .HasTitle = True
        .ChartTitle.Text = "月度各类型错误数量统计"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Text = "月份"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Text = "错误数量"
        .ApplyDataLabels ' 显示每个分段的数值标签，不需要可以删掉这行
    End With
    
    ' 如果不需要保留临时统计区域，取消下面一行的注释即可自动删除
    ' ws.Columns(auxStartCol).Resize(, 7).Clear
    
    MsgBox "堆叠条形图生成完成！"
End Sub

• 运行代码前先修改代码开头的参数配置区，确保工作表名、列号、起始行号和你的实际数据一致，可彻底解决下标越界问题
• 代码默认生成横向堆叠条形图，如果需要X轴（分类轴）为月份在底部的纵向堆叠柱形图，把代码里.ChartType = xlBarStacked改成.ChartType = xlColumnStacked即可
• 代码默认使用J列开始的区域做临时统计，统计完成后如果不需要保留汇总数据，取消对应行的注释即可自动清理
• 图表生成后可直接手动调整配色、大小、位置，不需要修改代码

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