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

Question

在通过另一个工作簿(比如工作簿1(中的VBA子例程打开excel工作簿(比如说工作簿2(后，我正试图从该工作簿中查找表(ListObject(。

我尝试的代码如下，

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

引用工作簿中的表

"Sub"示例

Sub LocateTableExample()

Const FilePath As String = "C:TestTest.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:TestTest.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