ExcelでSQLを使う-028: ソース公開-12 DSelect関数（Excel To Excel）
移行期も後半。
仔犬たちの生活サイクルが徐々にはっきりしてきました。
《２時間ほど寝て30分ほど起きて、オッパイを飲んで遊んでまた寝る》
のサイクルが生まれつつあります。
◇◇◇◇◇
１０、複数行を検索するDSelect関数
一列のみを検索するDLookup関数、一行のみを検索するELookup関数、そして複数行を検索するDSelect関数。それぞれにそれぞれの利用方法があります。DSelect関数の一つの利用例は、〔生徒の成績確認フォーム〕のそれです。
〔生徒の成績確認フォーム〕とDSeelct関数
次の〔生徒の成績確認フォーム〕では、〔生徒_№〕を入力すると＜成績表＞から〔種類〕が’期末試験’の全科目の〔成績〕を検索して表示するようになっています。この仕掛けの中心的な役割りを担っているのがDSelect関数です。
1.00;1;鈴木 一郎;1:英語;30|
2.00;1;鈴木 一郎;2:数学;40|
3.00;1;鈴木 一郎;3:国語;50|
4.00;1;鈴木 一郎;4:理科;40|
5.00;1;鈴木 一郎;5:社会;30
B4は、上記のデータが一列に並んでいます。A6～A10の式では、その各行を取り出しています。
A06=CutStr(B4, "|",1)・・・1.00;1;鈴木 一郎;英語;30
A07=CutStr(B4, "|",2)・・・2.00;1;鈴木 一郎;数学;40
A08=CutStr(B4, "|",3)・・・3.00;1;鈴木 一郎;国語;50
A09=CutStr(B4, "|",4)・・・4.00;1;鈴木 一郎;理科;40
A10=CutStr(B4, "|",5)・・・5.00;1;鈴木 一郎;社会;30
注意を要するのは、DSelect関数は7番目の引数でFalseを指定しないと先頭に行カンターを付与するということです。ですから、次のように一つズラして必要なデータを取り出します。
? CutStr(A06, ";", 2)
1
? CutStr(A06, ";", 3)
鈴木 一郎
? CutStr(A06, ";", 4)
英語
? CutStr(A06, ";", 5)
30
DSelect関数のみを利用した場合の注意点：
DSelect関数は、データを全て文字列として取得します。そのため、上図のように〔生徒_№〕や〔成績〕が左詰めで表示されます。それを右詰表示するのは、関数ユーザーの役目になります。
＜成績表＞の選択クエリとDSelect関数
上図は、Accessの選択クエリを表示したものです。DSelect関数でも、同じ検索結果を得ることができます。マクロ《成績表の選択クエリ》では、DSelect関数の３番目の引数（行区切り子）に改行コードを指定しています。
Sub 成績表の選択クエリ()
Dim strSQL As String
strSQL = "SELECT DISTINCTROW " & _
"生徒_№, 名前, 科目, Avg(成績) AS 平均点, Min(成績) AS 最低点, Max(成績) AS 最高点 " & _
"FROM [成績表$D3:J100] " & _
"GROUP BY 生徒_№, 名前, 科目 " & _
"ORDER BY 生徒_№;"
Debug.Print DSelect(strSQL, , Chr(13))
End Sub
DSelect関数の検索結果をシートに反映するのは SQLWriter関数、DSWriter関数の役目です。SQLWriter関数は、ピボットテーブルを生成する完全版。DSWriter関数は、SQLWriter関数から小集計表示機能を省いた簡便バージョンです。
Sub 成績表の選択クエリ2()
Dim strSQL As String
strSQL = "SELECT DISTINCTROW " & _
"生徒_№, 名前, 科目, Avg(成績) AS 平均点, Min(成績) AS 最低点, Max(成績) AS 最高点 " & _
"FROM [成績表$D3:J100] " & _
"GROUP BY 生徒_№, 名前, 科目 " & _
"ORDER BY 生徒_№;"
Call SQLWriter(strSQL, "New")
End Sub
SQLWriterで描画
＜成績表＞のクロス集計クエリとDSelect関数
上図は、Accessのクロス集計クエリを表示したものです。DSelect関数でも、同じ検索結果を得ることができます。
Sub 成績表のクロス集計クエリ()
Dim strSQL As String
strSQL = "TRANSFORM FIRST(成績) AS 成績の先頭" & _
" SELECT 名前" & _
" FROM [成績表$D3:J100]" & _
" WHERE 種類='期末試験'" & _
" GROUP BY 名前" & _
" ORDER BY 名前, 科目" & _
" PIVOT 科目"
Call DSWriter(strSQL, "New")
End Sub
DSWriterで描画
英数国の順番に列を並べるのに科目名を修正しています。いわゆる小集計欄を持つピボットテーブルでなければ、SQLWriter関数で描いてもDSWriter関数で描いても結果は同じです。
本稿でみたように、選択クエリ、クロス集計クエリ、重複クエリ、不一致クエリを実行して結果を戻すDSelect関数のソースは、次のようです。
DSelect関数
Public Function DSelect(ByVal strSQL As String, _
Optional ByVal colDelimita As String = ";", _
Optional ByVal rowDelimita As String = "|", _
Optional ByVal xlFileName As String = "", _
Optional ByVal isHeader As Boolean = True, _
Optional ByVal withFieldInfo As Boolean = False, _
Optional ByVal withCounter As Boolean = True) As String
On Error GoTo Err_DSelect
'
' 【要参照設定】
'
' Micrsoft ActiveX Data Objects 2.8 Library
'
Dim isData As Boolean
Dim intCounter As Integer
Dim strHDR As String
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim strData As String
Dim strList As String ' 全てのデータを区切子で連結して格納
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
'
' ThisWorkbook.FullName の指定
'
If Len(xlFileName) = 0 Then
xlFileName = ThisWorkbook.FullName
End If
'
' 接続設定
'
With cnn
strHDR = IIf(isHeader, "HDR=YES;", "HDR=NO;")
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0;" & strHDR & "IMEX=1;"
.Open xlFileName
'
' 列を読み込み
'
With rst
.Open strSQL, cnn, adOpenKeyset, adLockReadOnly
If Not .BOF Then
.MoveFirst
If withFieldInfo Then
'
' 列名を先頭に付与する
'
If withCounter = True Then
strList = "№" & colDelimita
End If
For Each fld In .Fields
strList = strList & fld.Name & colDelimita
Next fld
strList = strList & rowDelimita
strList = Replace(strList, colDelimita & rowDelimita, rowDelimita)
'
' 列タイプも先頭に付与する
'
If withCounter = True Then
strList = strList & "5" & colDelimita
End If
For Each fld In .Fields
strList = strList & fld.Type & colDelimita
Next fld
strList = strList & rowDelimita
strList = Replace(strList, colDelimita & rowDelimita, rowDelimita)
End If
'
' データを呼び込む
'
Do
'
' データチェック
'
strData = ""
For Each fld In .Fields
strData = strData & fld.Value
Next fld
isData = CBool(Len(strData) > 0)
'
' データ取得
'
If isData Then
intCounter = intCounter + 1
If withCounter = True Then
strList = strList & Format(intCounter, ".00") & colDelimita
End If
For Each fld In .Fields
strList = strList & fld.Value & colDelimita
Next fld
strList = Mid(strList, 1, Len(strList) - Len(colDelimita & "")) & rowDelimita
End If
.MoveNext
Loop Until (.EOF)
Else
strList = ""
End If
End With
End With
Exit_DSelect:
On Error Resume Next
rst.Close
Set rst = Nothing
DSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
Exit Function
Err_DSelect:
If isEcho Then
MsgBox "SELECT 文の実行時にエラーが発生しました。(DSelect)" & Chr(13) & Chr(13) & _
"・Err.Description=" & Err.Description & Chr(13) & _
"・SQL Text=" & strSQL, _
vbExclamation, " 関数エラーメッセージ"
End If
Resume Exit_DSelect
End Function
次のソース公開は、DSWriter関数です。
PS、エラー制御
DLookup関数、Elookup関数、DSelect関数を式に組み込んだ時は、広域変数 isEcho を真にしておくと、関連データを削除した際にエラーが表示されます。それが煩わしいので既定では、その値を偽にしていまっす。以下は、その真と偽とを切り替えるマクロです。
