ExcelでSQLを使う-022 ソース公開-06 DLookup関数（Excel To Excel）
生後13日目。
仔犬たちは、移行期を迎えました。
尾っぽで喜怒哀楽を表現するようになりつつあります。
◇◇◇◇◇
６、色々と活躍するDLookup関数
マイクロソフトが推奨する《良いデータベースデザイン》の指針に従えば、表＜成績表＞のレイアウトは上図のようになります。
１、生徒名と科目名は、表＜生徒名簿＞と表＜科目一覧＞を参照する。
２、生徒名を縦軸、科目名を横軸にした表＜成績一覧＞はレポート関数で生成する。
というのがデータベース構築の流儀です。
テーブルは、データを「蓄積・保存」するための「表形式」のオブジェクトです 。・・・・・レポートは、テーブルから取り出したデータや集計結果などの「印刷画面」となるオブジェクトです。（https://allabout.co.jp/gm/gc/441947/）
冒頭の表＜成績表＞がAccessのテーブル。それを基に作成する表＜成績一覧＞が同レポートに相当するーAccessでは、そういう考え方です。
DLookup関数で＜生徒名＞と＜科目名＞を参照する
O07=DLookup("SELECT MAX(成績) FROM [成績表$C3:I100]
WHERE 種類='" &N4 & "' AND 科目名='" & N7 & "'")
O14=DLookup("SELECT MIN(成績) FROM [成績表$C3:I100]
WHERE 種類='" & N4 & "' AND 科目名='" & N14 & "'")
O21=DLookup("SELECT AVG(成績) FROM [成績表$C3:I100]
WHERE 種類='" & N4 &"' AND 科目名='" & N14 & "'")
DLookup関数で最高点得点者、最低点得点者を表示する
鈴木君と中村君にとっては歓迎されない仕組みですが、次は”期末試験”の科目別の最高得点と最低点を取った生徒名を表示しています。
O07=DLookup("SELECT 生徒名 FROM [成績表$C3:I100]
WHERE 種類='" & N4 & "' AND 科目名='" & N7 & "'
ORDER BY 成績 DESC", 1)
O14=DLookup("SELECT 生徒名 FROM [成績表$C3:I100]
WHERE 種類='" & N4 & "' AND 科目名='" & N7 & "'
ORDER BY 成績", 1)
DLookup関数は、２番目の引数で《該当する何番目のデータを取得するかを1以上の値で指定》することができますので、このように最高得点者の生徒名なども簡単に検索することができます。
DLookup関数
随分と前置きが長くなりましたが、次がDLookup関数です。もちろん、外部ブックも参照できます。
Public isEcho As Boolean
O07=DLookup("SELECT 生徒名 FROM [成績表$C3:I100]
WHERE 種類='" & N4 & "' AND 科目名='" & N7 & "'
ORDER BY 成績 DESC", 1)
O14=DLookup("SELECT 生徒名 FROM [成績表$C3:I100]
WHERE 種類='" & N4 & "' AND 科目名='" & N7 & "'
ORDER BY 成績", 1)
DLookup関数は、２番目の引数で《該当する何番目のデータを取得するかを1以上の値で指定》することができますので、このように最高得点者の生徒名なども簡単に検索することができます。
DLookup関数
随分と前置きが長くなりましたが、次がDLookup関数です。もちろん、外部ブックも参照できます。
Public isEcho As Boolean
Public Function DLookup(ByVal strSQL As String, _
Optional ByVal intSearch As Integer = 1, _
Optional ByVal xlFileName As String = "", _
Optional ByVal isHeader As Boolean = True, _
Optional returnValue As Variant = "") As Variant
On Error GoTo Err_DLookup
'
' 【要参照設定】
'
' Micrsoft ActiveX Data Objects 2.8 Library
'
Dim R As Integer ' 行インデックス
Dim N As Integer ' 行総数 - 1
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strHDR As String
Dim varData
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 intSearch < 0 Then
intSearch = rst.RecordCount + intSearch + 1
End If
If Not .BOF Then
N = CInt(.RecordCount) - 1
intSearch = intSearch - 1
.MoveFirst
For R = 0 To N
If intSearch = R Then
varData = .Fields(0)
Exit For
End If
.MoveNext
Next R
End If
End With
End With
Exit_DLookup:
On Error Resume Next
rst.Close
Set rst = Nothing
DLookup = IIf(Len(varData & "") > 0, varData, returnValue)
Exit Function
Err_DLookup:
If isEcho Then
MsgBox "SELECT 文の実行時にエラーが発生しました。(DLookup)" & Chr(13) & Chr(13) & _
"・Err.Description=" & Err.Description & Chr(13) & _
"・SQL Text=" & strSQL, _
vbExclamation, " 関数エラーメッセージ"
Resume Exit_DLookup
End If
End Function
