如果在三个不同的范围内相交，则在调用Sub过程时，Excel VBA错误“下标超出范围”

我不明白为什么会出现此错误：“Excel VBA：下标超出范围”。当我删除VBA代码“组2”和“组1”的部分时，代码可以工作。
此外，是否有更好的方法来编写此代码以从缩写中获取完整的州名称？每次输入州的缩写时，代码应自动将表列范围中的单元格值更新为州的全名。
在图纸中：

Public Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, DataSheet.ListObjects("Group3").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

If Not Application.Intersect(Target, DataSheet.ListObjects("Group2").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

If Not Application.Intersect(Target, DataSheet.ListObjects("Group1").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

End Sub

在模块中：

Sub StateFullName(ByVal Target As Range)
On Error GoTo eh
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Target.Value = Replace(Target.Value, "AL", "Alabama")
Target.Value = Replace(Target.Value, "AK", "Alaska")
Target.Value = Replace(Target.Value, "AZ", "Arizona")
Target.Value = Replace(Target.Value, "AR", "Arkansas")
Target.Value = Replace(Target.Value, "AS", "American Samoa")
Target.Value = Replace(Target.Value, "CA", "California")
Target.Value = Replace(Target.Value, "CO", "Colorado")
Target.Value = Replace(Target.Value, "CT", "Connecticut")
Target.Value = Replace(Target.Value, "DE", "Delaware")
Target.Value = Replace(Target.Value, "DC", "District of Columbia")
Target.Value = Replace(Target.Value, "FL", "Florida")
Target.Value = Replace(Target.Value, "GA", "Georgia")
Target.Value = Replace(Target.Value, "GU", "Guam")
Target.Value = Replace(Target.Value, "HI", "Hawaii")
Target.Value = Replace(Target.Value, "ID", "Idaho")
Target.Value = Replace(Target.Value, "IL", "Illinois")
Target.Value = Replace(Target.Value, "IN", "Indiana")
Target.Value = Replace(Target.Value, "IA", "Iowa")
Target.Value = Replace(Target.Value, "KS", "Kansas")
Target.Value = Replace(Target.Value, "KY", "Kentucky")
Target.Value = Replace(Target.Value, "LA", "Louisiana")
Target.Value = Replace(Target.Value, "ME", "Maine")
Target.Value = Replace(Target.Value, "MD", "Maryland")
Target.Value = Replace(Target.Value, "MA", "Massachusetts")
Target.Value = Replace(Target.Value, "MI", "Michigan")
Target.Value = Replace(Target.Value, "MN", "Minnesota")
Target.Value = Replace(Target.Value, "MS", "Mississippi")
Target.Value = Replace(Target.Value, "MO", "Missouri")
Target.Value = Replace(Target.Value, "MT", "Montana")
Target.Value = Replace(Target.Value, "NE", "Nebraska")
Target.Value = Replace(Target.Value, "NV", "Nevada")
Target.Value = Replace(Target.Value, "NH", "New Hampshire")
Target.Value = Replace(Target.Value, "NJ", "New Jersey")
Target.Value = Replace(Target.Value, "NM", "New Mexico")
Target.Value = Replace(Target.Value, "NY", "New York")
Target.Value = Replace(Target.Value, "NC", "North Carolina")
Target.Value = Replace(Target.Value, "ND", "North Dakota")
Target.Value = Replace(Target.Value, "MP", "Northern Mariana Islands")
Target.Value = Replace(Target.Value, "OH", "Ohio")
Target.Value = Replace(Target.Value, "OK", "Oklahoma")
Target.Value = Replace(Target.Value, "OR", "Oregon")
Target.Value = Replace(Target.Value, "PA", "Pennsylvania")
Target.Value = Replace(Target.Value, "PR", "Puerto Rico")
Target.Value = Replace(Target.Value, "RI", "Rhode Island")
Target.Value = Replace(Target.Value, "SC", "South Carolina")
Target.Value = Replace(Target.Value, "SD", "South Dakota")
Target.Value = Replace(Target.Value, "TN", "Tennessee")
Target.Value = Replace(Target.Value, "TX", "Texas")
Target.Value = Replace(Target.Value, "TT", "Trust Territories")
Target.Value = Replace(Target.Value, "UT", "Utah")
Target.Value = Replace(Target.Value, "VT", "Vermont")
Target.Value = Replace(Target.Value, "VA", "Virginia")
Target.Value = Replace(Target.Value, "VI", "Virgin Islands")
Target.Value = Replace(Target.Value, "WA", "Washington")
Target.Value = Replace(Target.Value, "WV", "West Virginia")
Target.Value = Replace(Target.Value, "WI", "Wisconsin")
Target.Value = Replace(Target.Value, "WY", "Wyoming")
Target.Value = Application.WorksheetFunction.Trim(Target.Value)
Application.EnableEvents = True
eh: Application.EnableEvents = True
End Sub

确保你有一个以3个组中的每一个命名的表（包括是否有空格！）;在VBA中，“下标”是 * 数组索引访问 * 中括号之间的部分，但当试图从 * 键控对象集合 * 中检索项时，通常会重复出现相同的“下标超出范围”错误，例如ListObjects或Worksheets（主要是因为在这些情况中涉及的Item默认属性的Variant自变量可以是数字索引或字符串名称）。
这是静态字典查找的一个很好的用例-在StateCodes标准模块中定义字典：

Option Explicit
Private Lookup As Scripting.Dictionary 'early-bound requires reference to Scripting runtime library; use 'As Object' if late-bound.

Private Sub InitializeLookup()
    If Not Lookup Is Nothing Then Exit Sub
    Set Lookup = New Scripting.Dictionary 'late-bound: = CreateObject("Scripting.Dictionary")
    With Lookup
        .Add "AL", "Alabama"
        .Add "AK", "Alaska"
        .Add "AZ", "Arizona"
        '...
        .Add "WY", "Whyoming"
    End With
End Sub

现在剩下要做的就是编写一个小的helper函数（在同一个模块中）来执行查找：

'@Description "Gets the full name for the specified state code; returns True if the lookup succeeds, False otherwise."
Public Function TryGetNameFor(ByVal Code As String, ByRef outResult) As Boolean
    InitializeLookup
    If Lookup.Exists(Code) Then
        outResult = Lookup(Code)
        GetNameFor = True
    Else
        outResult = Code
        GetNameFor = False
    End If
End Function

现在SetStateFullName(ByVal Target As Range)宏（注意名称开头的动词！）可以如下所示：

Public Sub SetStateFullName(ByVal Target As Range)
    On Error GoTo CleanFail

    Dim FullName As String
    If StateCodes.TryGetNameFor(Target.Value, outResult:=FullName) Then
        Application.EnableEvents = False
        Target.Value = Replace(Target.Value, FullName)
    End If

CleanExit:
    'code here runs only once, regardless of whether there was an error or not
    Application.EnableEvents = True
    Exit Sub

CleanFail:
    'handle error here
    Resume CleanExit ' don't leave the scope in an error-handling state
End Sub

注意，我坚持使用VBA.String.Replace函数，但这里也可能使用了Range.Replace。

如果在三个不同的范围内相交，则在调用Sub过程时，Excel VBA错误“下标超出范围”

1条答案

相关问题

热门标签

最新问答