Excel VBA调用Sub出现‘Subscript out of range’错误及代码优化咨询

• 工作表中DataSheet.ListObjects("Group1")或DataSheet.ListObjects("Group2")不存在：检查Excel文件里是否有名为Group1、Group2的结构化表格，名字拼写需完全一致（含大小写）。
• 对应表格无"State"列：确认Group1、Group2表格里是否存在标题为"State"的列，拼写必须完全匹配。
• 表格无数据行：如果Group1或Group2只有表头没有数据，DataBodyRange会返回Nothing，此时访问.Rows会触发下标越界错误。

1. 工作表代码模块（对应目标工作表） #

Public Sub Worksheet_Change(ByVal Target As Range)
    Dim tblNames As Variant
    Dim tbl As ListObject
    Dim stateCol As ListColumn
    Dim targetRange As Range
    
    ' 定义需要监听的表格名称数组
    tblNames = Array("Group1", "Group2", "Group3")
    
    Application.EnableEvents = False
    On Error GoTo Cleanup
    
    For Each tblName In tblNames
        ' 检查表格是否存在
        On Error Resume Next
        Set tbl = DataSheet.ListObjects(tblName)
        On Error GoTo Cleanup
        
        If Not tbl Is Nothing Then
            ' 检查State列是否存在
            On Error Resume Next
            Set stateCol = tbl.ListColumns("State")
            On Error GoTo Cleanup
            
            If Not stateCol Is Nothing Then
                ' 检查表格是否有数据行
                If Not stateCol.DataBodyRange Is Nothing Then
                    Set targetRange = Application.Intersect(Target, stateCol.DataBodyRange)
                    If Not targetRange Is Nothing Then
                        StateFullName targetRange
                    End If
                End If
            End If
        End If
    Next tblName

Cleanup:
    Application.EnableEvents = True
End Sub

2. 标准模块代码 #

Sub StateFullName(ByVal Target As Range)
    Dim stateDict As Object
    Dim cell As Range
    Dim stateAbbr As String
    
    ' 创建州缩写-全名映射字典
    Set stateDict = CreateObject("Scripting.Dictionary")
    With stateDict
        .Add "AL", "Alabama"
        .Add "AK", "Alaska"
        .Add "AZ", "Arizona"
        .Add "AR", "Arkansas"
        .Add "AS", "American Samoa"
        .Add "CA", "California"
        .Add "CO", "Colorado"
        .Add "CT", "Connecticut"
        .Add "DE", "Delaware"
        .Add "DC", "District of Columbia"
        .Add "FL", "Florida"
        .Add "GA", "Georgia"
        .Add "GU", "Guam"
        .Add "HI", "Hawaii"
        .Add "ID", "Idaho"
        .Add "IL", "Illinois"
        .Add "IN", "Indiana"
        .Add "IA", "Iowa"
        .Add "KS", "Kansas"
        .Add "KY", "Kentucky"
        .Add "LA", "Louisiana"
        .Add "ME", "Maine"
        .Add "MD", "Maryland"
        .Add "MA", "Massachusetts"
        .Add "MI", "Michigan"
        .Add "MN", "Minnesota"
        .Add "MS", "Mississippi"
        .Add "MO", "Missouri"
        .Add "MT", "Montana"
        .Add "NE", "Nebraska"
        .Add "NV", "Nevada"
        .Add "NH", "New Hampshire"
        .Add "NJ", "New Jersey"
        .Add "NM", "New Mexico"
        .Add "NY", "New York"
        .Add "NC", "North Carolina"
        .Add "ND", "North Dakota"
        .Add "MP", "Northern Mariana Islands"
        .Add "OH", "Ohio"
        .Add "OK", "Oklahoma"
        .Add "OR", "Oregon"
        .Add "PA", "Pennsylvania"
        .Add "PR", "Puerto Rico"
        .Add "RI", "Rhode Island"
        .Add "SC", "South Carolina"
        .Add "SD", "South Dakota"
        .Add "TN", "Tennessee"
        .Add "TX", "Texas"
        .Add "TT", "Trust Territories"
        .Add "UT", "Utah"
        .Add "VT", "Vermont"
        .Add "VA", "Virginia"
        .Add "VI", "Virgin Islands"
        .Add "WA", "Washington"
        .Add "WV", "West Virginia"
        .Add "WI", "Wisconsin"
        .Add "WY", "Wyoming"
    End With
    
    Application.EnableEvents = False
    On Error GoTo Cleanup
    
    For Each cell In Target
        stateAbbr = UCase(Trim(cell.Value))
        ' 字典中存在该缩写则替换为全名，否则保留原内容
        If stateDict.Exists(stateAbbr) Then
            cell.Value = stateDict(stateAbbr)
        End If
    Next cell

Cleanup:
    Application.EnableEvents = True
End Sub

• 错误处理更健壮：新增表格、列存在性检查，以及数据行非空判断，避免触发下标越界错误。
• 代码复用性高：用数组存储表格名称，循环遍历，新增/删除监听表格只需修改数组，无需重复写判断逻辑。
• 替换逻辑更准确：使用字典实现精确匹配，避免原代码中Replace导致的部分匹配问题（比如输入"ALX"不会被错误替换为"Alabamax"）。
• 支持多单元格修改：优化后可批量处理选中多个单元格修改的场景。

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