Выполнение SQL-запросов в таблице Excel в рабочей книге с помощью макроса VBA

Я пытаюсь сделать макрос excel, который даст мне следующую функцию в Excel:

=SQL("SELECT heading_1 FROM Table1 WHERE heading_2='foo'")

Позволяет мне искать (и, возможно, даже вставлять) данные в мои таблицы рабочих книг, используя SQL-запросы.

Это то, что я сделал до сих пор:

Sub SQL()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM [Sheet1$A1:G3]"

rs.Open strSQL, cn

Debug.Print rs.GetString

End Sub

My script работает как шарм с жестко заданными диапазонами, такими как фрагмент выше. Он также отлично работает со статическими именованными диапазонами.

Однако он не будет работать ни с динамическими именованными диапазонами, ни с TABLE NAMES, что для меня является самым важным.

Ближайший я нашел ответ, этот парень страдает от одного и того же несчастья: http://www.ozgrid.com/forum/showthread.php?t=72973

Помогите кому-нибудь?

Edit

Я подготовил это до сих пор, я могу использовать результирующее имя в своих SQL-запросах. Ограничение заключается в том, что мне нужно знать, на каком листе эти таблицы. Можем ли мы что-то сделать?

Function getAddress()

    myAddress = Replace(Sheets("Sheet1").Range("Table1").address, "$", "")
    myAddress = "[Sheet1$" & myAddress & "]"

    getAddress = myAddress

End Function

Спасибо!

ОТВЕТЫ

Ответ 1

Одна вещь, которую вы можете сделать, это получить адрес динамического именованного диапазона и использовать его в качестве ввода в вашей строке SQL. Что-то вроде:

Sheets("shtName").range("namedRangeName").Address

Что будет выплевывать строку адреса, что-то вроде $A$1:$A$8

Edit:

Как я уже сказал в моем комментарии ниже, вы можете динамически получить полный адрес (включая имя листа) и либо использовать его напрямую, либо проанализировать имя листа для последующего использования:

ActiveWorkbook.Names.Item("namedRangeName").RefersToLocal

В результате получается строка типа =Sheet1!$C$1:$C$4. Итак, для вашего примера кода выше, ваш оператор SQL может быть

strRangeAddress = Mid(ActiveWorkbook.Names.Item("namedRangeName").RefersToLocal,2)

strSQL = "SELECT * FROM [strRangeAddress]"

Ответ 2

Public Function GetRange(ByVal sListName As String) As String

Dim oListObject As ListObject
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook

For Each ws In wb.Sheets
    For Each oListObject In ws.ListObjects
        If oListObject.Name = sListName Then
            GetRange = "[" & ws.Name & "$" & Replace(oListObject.Range.Address, "$", "") & "]"
        Exit Function
        End If
    Next oListObject
Next ws


End Function

В вашем SQL-режиме это выглядит как

sSQL = "Select * from " & GetRange("NameOfTable") & ""

Ответ 3

Основываясь на рутине Джоан-Диего Родригес с подходом Хорди и некоторым кодом Яцека Котовского - эта функция преобразует любое имя таблицы для активной книги в полезный адрес для SQL-запросов.

Примечание для MikeL: добавление "[#All]" включает заголовки, избегающие проблем, о которых вы сообщали.

Function getAddress(byVal sTableName as String) as String 

    With Range(sTableName & "[#All]")
        getAddress= "[" & .Parent.Name & "$" & .Address(False, False) & "]"
    End With

End Function

Ответ 4

Я новичок, потрудился над чьим-то другим кодом, поэтому, пожалуйста, будьте снисходительны и исправляйте мои ошибки. Я пробовал ваш код и играл с помощью VBA. Следующие работали со мной:

Function currAddressTest(dataRangeTest As Range) As String

    currAddressTest = ActiveSheet.Name & "$" & dataRangeTest.Address(False, False)

End Function

Когда я выбираю аргумент источника данных для своей функции, он преобразуется в формат Sheet1 $A1: G3. Если excel изменяет его на таблицу1 [#All] ссылку в моей формуле, функция все еще работает правильно

Затем я использовал его в вашей функции (пытался воспроизвести и добавить еще один аргумент, который нужно ввести в WHERE...

Function SQL(dataRange As Range, CritA As String)

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim currAddress As String



currAddress = ActiveSheet.Name & "$" & dataRange.Address(False, False)

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon


strSQL = "SELECT * FROM [" & currAddress & "]" & _
         "WHERE [A] =  '" & CritA & "'  " & _
         "ORDER BY 1 ASC"

rs.Open strSQL, cn

SQL = rs.GetString

End Function

Надеюсь, что ваша работа будет развиваться дальше, я считаю ее очень полезной. Приятного дня!

Ответ 5

Просто отвечая на вторую часть вашего вопроса о получении имени листа, где находится таблица:

Dim name as String

name = Range("Table1").Worksheet.Name

Edit:

Чтобы сделать более понятным: кто-то предложил использовать Range на объекте Sheet. В этом случае вам не нужно; Диапазон, в котором находится таблица, может быть получен с использованием имени таблицы; это имя доступно во всей книге. Таким образом, Call Range работает хорошо.

Ответ 6

Привет, недавно рассмотрел этот вопрос и имел проблемы со ссылкой на именованную таблицу (объект списка) в excel

если вы помещаете суффикс '$' в имя таблицы, все хорошо в мире

Sub testSQL()

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

    ' Declare variables
    strFile = ThisWorkbook.FullName

    ' construct connection string
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    ' create connection and recordset objects
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    ' open connection
    cn.Open strCon

    ' construct SQL query
    strSQL = "SELECT * FROM [TableName$] where [ColumnHeader] = 'wibble';"

    ' execute SQL query
    rs.Open strSQL, cn

    Debug.Print rs.GetString

    ' close connection
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub

Ответ 7

Два массива из табличных функций, которые у меня есть в моем общем модуле

Function ArrayfromTable(sourceWsName As String, sourceTableName As String) As Variant

    ArrayfromTable = ThisWorkbook.Worksheets(sourceWsName).ListObjects(sourceTableName).DataBodyRange.Value

End Function
------------------------------------------
Function ArrayfromTableName(sourceTableName As String) As Variant
    Dim sourceWsName As String

    sourceWsName = Range(sourceTableName).Worksheet.Name

    ArrayfromTable = ThisWorkbook.Worksheets(sourceWsName).ListObjects(sourceTableName).DataBodyRange.Value

End Function