excel - 按名称引用 QueryTable 对象

Question

我正在使用 VBA 开发 MS Excel 2013 工具，其中涉及 QueryTables 的使用。

访问 Excel 工作表中的现有查询表是一个不便之处。目前，我能找到的访问查询表的唯一方法是通过整数索引。我想出了以下代码来快速证明概念:

Sub RefreshDataQuery()

Dim querySheet As Worksheet
Dim interface As Worksheet

Set querySheet = Worksheets("QTable")
Set interface = Worksheets("Interface")

Dim sh As Worksheet
Dim QT As QueryTable

Dim startTime As Double
Dim endTime As Double

Set QT = querySheet.ListObjects.item(1).QueryTable

startTime = Timer
QT.Refresh
endTime = Timer - startTime

interface.Cells(1, 1).Value = "Elapsed time to run query"
interface.Cells(1, 2).Value = endTime
interface.Cells(1, 3).Value = "Seconds"

End Sub

这可行，但我不想这样做。最终产品工具将具有最多五个不同的查询表。我想通过名称引用查询表。

我该如何翻译:

Set QT = querySheet.ListObjects.item(1).QueryTable

类似于以下内容:

Set QT = querySheet.ListObjects.items.QueryTable("My Query Table")

Answer 1

在 Excel 2003 及更早版本中，外部数据连接将创建一个 QueryTable 对象，其父级是工作表。例如，您可以通过 QueryTables 集合对象访问 QueryTable 对象。与大多数集合对象一样，您可以将索引号或名称传递给(默认)Item 方法来获取它。

Sheet1.QueryTables("MyQtName")

当您在新版本中打开 2003 工作表时，它仍然有一个 QueryTable 对象，并且可以通过相同的方式访问。即使您转换文件格式，QueryTable 仍然存在。

在 2007 及更高版本中，只有三种方法可以创建将成为 Worksheet.QueryTables 成员的 QueryTable:

1. 通过代码
2. 数据 - 来自文本
3. 数据 - 来自网络

这些新版本中的所有其他 UI 外部数据连接将不会生成 QueryTables 成员，而是生成 ListObject。该 ListObject 将具有且仅有一个可通过 ListObject.QueryTable 属性访问的 QueryTable 对象。

这是个坏消息。 ListObject 中的父级 QueryTable 没有 Name 属性。嗯，它就在那里，但是如果您尝试访问它，您将收到运行时错误 1004。我猜 MS 决定，因为每个 ListObject 只有一个 QueryTable，所以它应该有一个名称是没有意义的。

如果您尝试将 Worksheet.QueryTables.QueryTable 转换为 ListObject，外部数据连接将消失，并且新的 ListObject 没有 QueryTable。

由于您的 QueryTables.Count 返回零，因此所有 QueryTables 都位于 ListObjects 内并且没有名称。 ListObjects 有名称。您可以使用

Sheet1.ListObjects("MyListName").QueryTable

这是一个函数，它接受一个名称和一个工作表，并返回一个具有该名称的 QueryTable，或者是具有该名称的 ListObject 的子级。

Public Function QueryTableByName(ByVal sName As String, ByRef sh As Worksheet) As QueryTable

    Dim qt As QueryTable
    Dim lo As ListObject

    On Error Resume Next
        Set qt = sh.QueryTables(sName)
    On Error GoTo 0

    If qt Is Nothing Then
        On Error Resume Next
            Set lo = sh.ListObjects(sName)
        On Error GoTo 0

        If Not lo Is Nothing Then
            On Error Resume Next
                Set qt = lo.QueryTable
            On Error GoTo 0
        End If
    End If

    Set QueryTableByName = qt

End Function