Vba 获取列表对象上的下标超出范围错误

所以，我一直在编写一个代码，允许通过excel编辑数据库表，但我遇到了一个表对象的问题

代码在其他工作表上的编写方式几乎完全相同，但由于某些原因，只有此工作表在设置列表对象时出现下标超出范围错误。我检查了表的名称，并尝试更改了几次。我错过了什么

以下是迄今为止的代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CustomersConn As ADODB.Connection
    Dim CustomersCmd As ADODB.Command
    Dim lo As Excel.ListObject
    Dim ws As Excel.Worksheet
    Dim lrs As Range
    Dim lr As Excel.ListRow
    Dim Customers As Variant
    Dim areaCount As Integer
    Dim i As Integer
    Dim Rows As Range
    Dim rRow As Range
    Dim lRows As Excel.ListRows
    Dim Counter As Double

    Set ws = ThisWorkbook.Worksheets(11)
    Set lo = ws.ListObjects("TProspects")
    Set CustomersConn = New ADODB.Connection
    Set CustomersCmd = New ADODB.Command
    Set lrs = Target

    For Each Rows In lrs.Rows
        On Error GoTo jmp

        '========Section 1===========
        If Counter < 1 Then
            Intersect(lr.Range, lo.ListColumns("ID").Range).Value = WorksheetFunction.Max(lo.ListColumns("ID").Range) + 1
        End If
        '^^^^^^^^Section 1^^^^^^^^^^^

        Set lr = lo.ListRows(Rows.Row - 5)


        CustomersConn.ConnectionString = SQLConStr
        CustomersConn.Open
        CustomersCmd.ActiveConnection = CustomersConn

        CustomersCmd.CommandText = _
            GetUpdateText( _
            Intersect(lr.Range, lo.ListColumns("ID").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Prospect").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Contact").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Email").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Phone").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Address").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("City").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("State").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Zip").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Buying Group").Range).Value, _
            Intersect(lr.Range, lo.ListColumns("Type").Range).Value)

        CustomersCmd.Execute

    Next Rows

    CustomersConn.Close

    Set CustomersConn = Nothing
    Set lo = Nothing
    Set ws = Nothing
    Set lr = Nothing

    Application.Calculation = xlCalculationAutomatic

jmp:
End Sub

---

Matt Cremeens和Andrew Wynn提出了一个有效的观点，这一观点将我引向了我需要去的地方

---

虽然我确实在工作表索引11上有表，但出于什么原因，使用工作表的名称而不是索引值是有效的。我完全忘记了工作表是一个关联数组。至于该指数为何不起作用，这完全是个谜

Matt Cremeens和Andrew Wynn提出了一个有效的观点，指引我去我需要去的地方

---

虽然我确实在工作表索引11上有表，但出于什么原因，使用工作表的名称而不是索引值是有效的。我完全忘记了工作表是一个关联数组。至于该指数为何不起作用，这完全是个谜

如果不查看代码的实际数据，这是相当困难的，但是错误“设置列表对象时下标超出范围错误”几乎总是与遍历数组有关，可以是：1。您正在尝试遍历一个数组，该数组中没有任何内容，或者。。。2.您正在超出数组的可索引范围。在编写代码的情况下，请确保检查“对于lrs.Rows中的每一行”，“设置lr=lo.ListRows（Rows.Row-5）”和“Intersect（lr.Range，lo.ListColumns（“ID”）.Range）。Value=WorksheetFunction.Max（lo.ListColumns（“ID”）.Range）+1”检查这些行。除了Matt说的之外，您确定有索引为11的工作表吗，您确定您的表肯定在工作表索引11上吗？另外，不要使用

行

作为变量名，因为它是一个内部集合对象，任何人都很难调试。e、 g.

Rows=范围.Rows

。eurghError建议在不查看代码的实际数据的情况下，

ListObject

不会被命名为“TProspects”，这是相当困难的，但是错误“设置列表对象时下标超出范围错误”几乎总是与通过数组进行迭代有关，可以是：1。您正在尝试遍历一个数组，该数组中没有任何内容，或者。。。2.您正在超出数组的可索引范围。在编写代码的情况下，请确保检查“对于lrs.Rows中的每一行”，“设置lr=lo.ListRows（Rows.Row-5）”和“Intersect（lr.Range，lo.ListColumns（“ID”）.Range）。Value=WorksheetFunction.Max（lo.ListColumns（“ID”）.Range）+1”检查这些行。除了Matt说的之外，您确定有索引为11的工作表吗，您确定您的表肯定在工作表索引11上吗？另外，不要使用

行

作为变量名，因为它是一个内部集合对象，任何人都很难调试。e、 g.

Rows=范围.Rows

。eurghError建议将

列表对象

命名为

“TProspects”

Function GetUpdateText(ID As Double, Prospect As String, Contact As String, Email As String, Phone As String, Address As String, City As String, State As String, Zip As Double, Corp As String, CType As String) As String

    Dim SQLStr As String

    SQLStr = _
        "UPDATE Prospect" & _
        " SET Type = '" & CType & "'," & _
        "Prospect = '" & Replace(Prospect, "'", "''") & "'," & _
        "Contact = '" & Contact & "'," & _
        "Email = '" & Email & "'," & _
        "Phone = '" & Phone & "'," & _
        "Address = '" & Address & "'," & _
        "City = '" & City & "'," & _
        "State = '" & State & "'," & _
        "Zip = " & Zip & "," & _
        "[Buying Group] = '" & Corp & "'" & _
        "WHERE ID = " & ID & _
        "IF @@ROWCOUNT=0" & _
        "INSERT INTO Prospect (" & _
        "Type,Contact,Prospect,Email,Phone,Address,City,State,Zip,[Buying Group])" & _
        "VALUES (" & _
        "'" & CType & "'," & _
        "'" & Contact & "'," & _
        "'" & Replace(Prospect, "'", "''") & "'," & _
        "'" & Email & "'," & _
        "'" & Phone & "'," & _
        "'" & Address & "'," & _
        "'" & City & "'," & _
        "'" & State & "'," & "'" & Zip & "'," & "'" & Corp & "')"

    GetUpdateText = SQLStr

End Function