Excel VBA：如何合并两个ListObjects集合并统一遍历？

初始需求与错误尝试 #

原本使用以下代码可正常遍历工作表"Categories"的所有ListObjects：

For Each objs In Sheets("Categories").ListObjects
     ' 业务逻辑代码
Next

现在需要将工作表"Payroll"的ListObjects也加入遍历集合，期望实现类似For Each objs In Sheets("Categories").ListObjects AND Sheets("Payroll").ListObjects的统一遍历逻辑。

第一次尝试用Collection合并两个工作表的ListObjects，代码如下：

Dim myCol as Collection
set myCol as New Collection

For Each objs in Sheets("Categories").ListObjects
     myCol.Add Sheets("Categories").ListObjects(objs)
Next

For Each objs in Sheets("Payroll").ListObjects
     myCol.Add Sheets("Payroll").ListObjects(objs)
Next

运行时抛出运行时错误'9'（下标越界），尝试声明变量为ListObjects类型也无效。

测试代码的问题排查 #

后续编写测试代码验证：

Sub Test()

Dim wb As Workbook: Set wb = ThisWorkbook

    Dim wsName As Variant
    For Each wsName In Array("Categories", "Payroll")
        Debug.Print "wsName= " & wsName
        Dim objs As ListObject
        Dim myCol As Collection: Set myCol = New Collection
        For Each objs In wb.Sheets(wsName).ListObjects
            Debug.Print "objs.name= " & objs.Name
            myCol.Add objs
        Next
    Next
    Dim cnt As Integer
    cnt = 0
    For Each objs In myCol
        cnt = cnt + 1
        Debug.Print "myCol Loop= " & objs.Name & " " & cnt
    Next

End Sub

立即窗口输出：

wsName= Categories
objs.name= CategoriesTbl
objs.name= ProjectsTbl
objs.name= CropsTbl
objs.name= Ranch_ExpensesTbl
objs.name= UtilitiesTbl
objs.name= LivestockTbl
objs.name= Livestock_SubTbl
objs.name= FuelTbl
objs.name= Farm_Equipment_MaintenanceTbl
objs.name= Vehicle_MaintenanceTbl
objs.name= AirBnBTbl
objs.name= IncomeTbl
objs.name= Crops_SubTbl
wsName= Payroll
objs.name= Payroll
myCol Loop= Payroll 1

可见循环能遍历两个工作表的所有ListObjects，但Collection中仅保留了Payroll的对象，原因是每次遍历工作表时都重新创建了Collection，覆盖了之前的内容。

正确实现方式 #

将Collection的初始化代码移到工作表遍历循环之外，即可正确合并所有ListObjects：

Sub Test_Fixed()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim myCol As Collection: Set myCol = New Collection ' 初始化移到外层

Dim wsName As Variant
For Each wsName In Array("Categories", "Payroll")
    Debug.Print "wsName= " & wsName
    Dim objs As ListObject
    For Each objs In wb.Sheets(wsName).ListObjects
        Debug.Print "objs.name= " & objs.Name
        myCol.Add objs
    Next
Next

Dim cnt As Integer
cnt = 0
For Each objs In myCol
    cnt = cnt + 1
    Debug.Print "myCol Loop= " & objs.Name & " " & cnt
Next

End Sub

此外，第一次尝试的下标越界问题，是因为Sheets("Categories").ListObjects(objs)的写法错误——objs本身就是ListObject对象，直接添加objs即可，无需通过集合下标访问。

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