迭代以在工作簿中查找列表对象

Question

我试图通过另一个工作簿中的 VBA 子例程打开 excel 工作簿（让我们说工作簿 2）中的 table （ ListObject ）（让我们说）说工作簿 1).

我试过的代码如下，

Sub B()
        Dim TBL_EMP As ListObject
        Dim strFile As Variant
        Dim WS_Count As Integer
        
        strFile = "File Path"
        Set WB_TRN = Workbooks.Open(strFile)
        
        WS_Count = WB_TRN.Worksheets.Count
        For n = 1 To WS_Count
                On Error GoTo Next_IT
                Set TBL_EMP = WB_TRN.Worksheets(n).ListObjects("EmployeeNameTbl")
                If Not TBL_EMP Is Nothing Then
                    MsgBox "Object Found"
                End If
    Next_IT:
        Next n
    End Sub

当我运行子例程时，它仅迭代 2 个工作表并给出错误代码 9"（下标超出范围），即使工作簿 2 有 10 个工作表。

如果我通过文件打开对话框打开工作簿 2，则代码可以正常工作。

请帮我解决这个问题。提前谢谢你

Answer 1

在工作簿中引用 Table

一个'Sub'例子

Sub LocateTableExample()
    
    Const FilePath As String = "C:\Test\Test.xlsx"
    Const TableName As String = "EmployeeNameTbl"
    
    Dim wb As Workbook: Set wb = Workbooks.Open(FilePath)
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim tbl As ListObject
    Dim IsFound As Boolean
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        On Error Resume Next
            Set tbl = ws.ListObjects(TableName)
        On Error GoTo 0
        If Not tbl Is Nothing Then
            IsFound = True
            Exit For ' stop looping, it is found
        End If
    Next ws

    ' Continue using the 'tbl' and 'ws' variables.
    Debug.Print tbl.Name
    Debug.Print ws.Name

            
    If IsFound Then
        MsgBox "Table found in worksheet '" & ws.Name & "'.", vbInformation
    Else
        MsgBox "Table not found.", vbCritical
    End If
    
End Sub

使用函数

程序 ReferenceTableTest 利用（调用）以下 ReferenceTable 函数。

Sub ReferenceTableTest()
    
    Const FilePath As String = "C:\Test\Test.xlsx"
    Const TableName As String = "EmployeeNameTbl"
        
    Dim wb As Workbook: Set wb = Workbooks.Open(FilePath)
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim tbl As ListObject: Set tbl = ReferenceTable(wb, TableName)
    If tbl Is Nothing Then Exit Sub
    
    Debug.Print "Get the Names Using the 'tbl' variable"
    Debug.Print "Table Name:     " & tbl.Name
    Debug.Print "Worksheet Name: " & tbl.Range.Worksheet.Name
    Debug.Print "Workbook Name:  " & tbl.Range.Worksheet.Parent.Name
    
End Sub

Function ReferenceTable( _
    ByVal wb As Workbook, _
    ByVal TableName As String) _
As ListObject
    Const ProcName As String = "ReferenceTable"
    On Error GoTo ClearError
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    
    For Each ws In wb.Worksheets
        On Error Resume Next
            Set tbl = ws.ListObjects(TableName)
        On Error GoTo 0
        If Not tbl Is Nothing Then
            Set ReferenceTable = tbl
            Exit For
        End If
    Next ws
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

迭代以在工作簿中查找列表对象

Iterate to Find Listobject in a Workbook

excel

vba

excel-tables

在工作簿中引用 Table