web-dev-qa-db-ja.com

VBAマクロを使用してワークブック内のExcelテーブルでSQLクエリを実行する

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

私のスクリプトは、上のスニペットのようなハードコードされた範囲を持つチャームのように機能します。静的な名前付き範囲でも非常にうまく機能します。

ただし、動的な名前付き範囲または私にとって最も重要なテーブル名のいずれでも機能しません。

私が答えで見つけた最も近いものは、同じ苦しみに苦しんでいるこの男です: http://www.ozgrid.com/forum/showthread.php?t=7297

誰か助けて?

編集

これまでこれを作成しましたが、SQLクエリで結果の名前を使用できます。制限は、テーブルがどのシートにあるかを知る必要があることです。それについて何かできますか?

Function getAddress()

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

    getAddress = myAddress

End Function

ありがとう!

29

できることの1つは、動的な名前付き範囲のアドレスを取得し、それをSQL文字列の入力として使用することです。何かのようなもの:

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

$A$1:$A$8のようなアドレス文字列を吐き出します

編集:

以下のコメントで述べたように、完全なアドレス(シート名を含む)を動的に取得し、それを直接使用するか、後で使用するためにシート名を解析できます。

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

=Sheet1!$C$1:$C$4のような文字列になります。上記のコード例では、SQLステートメントは次のようになります。

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

strSQL = "SELECT * FROM [strRangeAddress]"
14
Jake Bathman
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") & ""
8
Johan Kreszner

Joor-Diego RodriguezのルーチンをJordiのアプローチとJacek Kotowskiのコードで構築-この関数は、アクティブなブックのテーブル名を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
Craig Hatmaker

私は他の誰かのコードをいじっている初心者ですので、寛大になり、エラーをさらに修正してください。私はあなたのコードを試し、VBAヘルプで遊んでみました。

Function currAddressTest(dataRangeTest As Range) As String

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

End Function

関数のデータソース引数を選択すると、Sheet1 $ A1:G3形式に変換されます。 Excelが式でTable1 [#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

あなたの機能がさらに発展することを願っています、私はそれが非常に役立つと思います。ごきげんよう!

2
Jacek Kotowski

テーブルがあるシートの名前を取得することに関する質問の2番目の部分に答えるだけです。

Dim name as String

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

編集:

物事をより明確にするために、誰かがSheetオブジェクトでRangeを使用することを提案しました。この場合、必要はありません。テーブルが存在する範囲は、テーブルの名前を使用して取得できます。この名前は本全体で利用可能です。したがって、Rangeを単独で呼び出すとうまくいきます。

1
Jordi

こんにちは最近これを見て、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
0
MikeL