http://mukaer.com/archives/2010/10/17/excelsqlvlookup/
http://yizndev.blogspot.jp/2015/01/excel-sql.html
https://qiita.com/acknpop/items/cd4a6fe32bf6af409aa3
Const oRow = 2 'OutPutCellRow Const oColumn = 1 'OutPutCellColumn Const SQLCell = "B1" Sub ESQL() Dim sql Dim str 'SQL(B1セル) sql = Range(SQLCell).Value 'ツール → 参照設定 → ' Microsoft ActiveX Data Objects 2.8 Library 'チェック Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim xl_file As String xl_file = ThisWorkbook.FullName '他のブックを指定しても良し Set cn = New ADODB.Connection cn.Provider = "MSDASQL" cn.ConnectionString _ = "Driver={Microsoft Excel Driver (*.xls)};" _ & "DBQ=" & xl_file & "; ReadOnly=False;" cn.Open Set rs = New ADODB.Recordset rs.Open sql, cn, adOpenStatic 'フィールドNAME表示 For i = 0 To rs.Fields.Count - 1 Cells(oRow, i + 1).Value = rs(i).Name Next 'カラム表示 j = oRow + 1 Do Until rs.EOF '1 レコード毎の処理 For i = 0 To rs.Fields.Count - 1 Cells(j, i + 1).Value = rs(i).Value Next j = j + 1 rs.MoveNext Loop rs.Close cn.Close End Sub Sub ClearCells() Dim lRow 'LastCellRow Dim lColumn 'LastCellColumn lRow = Cells(oRow, oColumn).End(xlDown).Row lColumn = Cells(oRow, oColumn).End(xlToRight).Column '文字クリア ActiveSheet.Range(Cells(oRow, oColumn), Cells(lRow, lColumn)).ClearContents End Sub